BMUG PD-ROM A/PD-ROM A.iso/Utility/Network/Asynchronous Networking/ULACS.inc1.p

Text File | 1990-12-21 | 92.9 KB | 3,415 lines | [TEXT/MPS ]

{$P}
{ ULACS.inc1.p }
{ Copyright © 1988 - 1990 Apple Computer, Inc.    All rights reserved. }

var

gAboutWindow: TWindow;            { About box window. }
gPssster: TPssst;                        { About box animation object. }
gADSP: integer;                        { Driver number for ADSP. }

{--------------------------------------------------------------------------------------------------}

{$S ARes}

function GetNow: longInt;
    { Return the current time (in seconds since 1904). }

    var l: longInt;

    begin
        GetDateTime(l);
        GetNow := l;
    end;

function Expired(d: longInt): boolean;
    { Return true if this message is expired. Consider it expired also if it's positive or -1. Positive means
        an expiration date earlier than 1968, which doesn't make sense any more, and eliminating them
        avoids signed comparison problems. -1 used to be used for "kill" messages, but we've taken this
        feature out, and this eliminates any old kill messages still floating around. }

    begin
        Expired := (d >= -1) or (d <= GetNow);
    end;

{--------------------------------------------------------------------------------------------------}

{$S ARes}

function LongAsString(l: longInt): Str255;
    { Convert a long into a string. }

    var s: Str255;

    begin
        NumToString(l,s);
        LongAsString := s;
    end;

function BoolAsString(b: boolean): Str255;
    { Convert a boolean into a string. }

    begin
        if b then BoolAsString := 'true'
        else BoolAsString := 'false';
    end;

{--------------------------------------------------------------------------------------------------}

{$S ARes}

procedure PutNextString(var p: Ptr; var sz: longInt; s: Str255);
    { Store a string into a buffer, and append a tab (field separator). Increment the pointer and size as we go.
        Note: the buffer must be large enough to hold the string without overflowing. }

    begin
        BlockMove(Ptr(ord4(@s)+1),p,length(s));
        p := Ptr(ord4(p)+length(s));
        p^ := kTab;
        p := Ptr(ord4(p)+1);
        sz := sz + length(s) + 1;
    end;

procedure PutNextHandle(var p: Ptr; var sz: longInt; h: Handle);
    { Store a handle into a buffer, and append a tab (field separator). Increment the pointer and size as we go.
        Note: the buffer must be large enough to hold the string without overflowing. }

    var l: longInt;

    begin
        l := GetHandleSize(h);
        BlockMove(h^,p,l);
        p := Ptr(ord4(p)+l);
        p^ := kTab;
        p := Ptr(ord4(p)+1);
        sz := sz + l + 1;
    end;

{--------------------------------------------------------------------------------------------------}

{$S ARes}

function BuildPull(p: Ptr): longInt;
    { Creat a pull command in the buffer pointed to by p. }

    var sz: longInt;

    begin
        sz := 0;
        PutNextString(p,sz,'Pull');
        p^ := kReturn;
        sz := sz+1;
        BuildPull := sz;
    end;

function BuildPullCold(p: Ptr): longInt;
    { Creat a pull cold command in the buffer pointed to by p. }

    var sz: longInt;

    begin
        sz := 0;
        PutNextString(p,sz,'PullCold');
        p^ := kReturn;
        sz := sz+1;
        BuildPullCold := sz;
    end;

{--------------------------------------------------------------------------------------------------}

{$S ARes}

function TLACSApplication.DoMakeDocument(itsCmdNumber: CmdNumber): TDocument;
    { Make a new document. }

    var messagesDoc: TLACSDocument;

    begin
        New(messagesDoc);
        FailNil(messagesDoc);
        messagesDoc.ILACSDocument;
        DoMakeDocument := messagesDoc;
    end;

{--------------------------------------------------------------------------------------------------}
{$S ARes}

function TLACSApplication.DoMenuCommand(aCmdNumber: CmdNumber): TCommand;
    { Handle menu commands. }

    var f: AppFile;
        fInfo: FInfo;
        ignore: OSErr;

    procedure saveOne(d: TDocument);
        { Save a document. }

        begin
            d.Save(cSave,false,false);
        end;

    begin
        DoMenuCommand := nil;
        { Check if we should pass the command on to the document (this is in case all windows are closed). }
        if (aCmdNumber in
                [cMessagesWindow,cNewWindow,cStatusWindow,cMarkAllRead,cClearMessages,cPreferences])
                and (gDocList.fSize > 0) then
            DoMenuCommand := TDocument(gDocList.At(1)).DoMenuCommand(aCmdNumber)

        { Otherwise, handle it locally if it's one of ours. }
        else case aCmdNumber of

            cAboutApp:
                begin
                    { Display the About... window and bring it to the front. }
                    gAboutWindow.Show(true,true);
                    gAboutWindow.Select;
                end;

            cFinderNew:
                begin
                    { Just started up. Make sure the settings file is there and ready for us. }
                    f.vRefnum := gConfiguration.sysVRefNum;
                    f.fName := GetString(kSettingsFileSTR)^^;
                    if GetFInfo(f.fName,f.vRefnum,fInfo) <> noErr then
                        begin
                            { File not there, or weird in some way. Thwack it, and create a new one. }
                            ignore := FSDelete(f.fName,f.vRefnum);
                            ignore := Create(f.fName,f.vRefnum,kSignature,kLACSSettings);
                        end;
                    { Open the settings file (DoRead'll take care of default values if the file was just created). }
                    OpenOld(cOpen,f);
                end;

            cQuit:
                begin
                    { Make sure we save everything first. }
                    gDocList.Each(saveOne);
                    { Then let MacApp do it's normal quit stuff. }
                    DoMenuCommand := inherited DoMenuCommand(aCmdNumber);
                end;

            { If it's not ours, let someone else handle it. }
            otherwise DoMenuCommand := inherited DoMenuCommand(aCmdNumber);
            end;
    end;

{--------------------------------------------------------------------------------------------------}
{$S ARes}

procedure TLACSApplication.DoSetupMenus;
    { Enable the appropriate menus. }

    begin
        inherited DoSetupMenus;
        Enable(cAboutApp,true);
        { We need this just in case all the windows are closed. }
        if gDocList.fSize > 0 then
            begin
                Enable(cMessagesWindow,true);
                Enable(cNewWindow,true);
                Enable(cStatusWindow,true);
                Enable(cMarkAllRead,true);
                Enable(cClearMessages,true);
                Enable(cPreferences,true);
            end;
    end;

{--------------------------------------------------------------------------------------------------}

{$S AFields}

procedure TLACSApplication.Fields(procedure DoToField(fieldName: Str255; fieldAddr: Ptr;
                                    fieldType: integer));

    begin
        DoToField('TLACSApplication', nil, bClass);
        DoToField('gAboutWindow', @gAboutWindow, bObject);
        DoToField('gPssster', @gPssster, bObject);
        DoToField('gADSP', @gADSP, bInteger);
        inherited Fields(DoToField);
    end;

{--------------------------------------------------------------------------------------------------}

{$S AFree}

procedure TLACSApplication.Free;

    begin
        { Free our periodic object that updates the "psssts"s. }
        gPssster.Free;
        inherited Free;
    end;

{--------------------------------------------------------------------------------------------------}

{$S AInit}

procedure TLACSApplication.ILACSApplication(itsMainFileType: OSType);

    var i: integer;

    begin
        IApplication(itsMainFileType);

        { Init the random number generator. }
        GetDateTime(randSeed);

        { Set up the about box. }
        new(gPssster);
        FailNil(gPssster);
        gPssster.IPeriodic(kPssstInitial,kPssstInactive,kPssstActive);

        { Init the network. }
        if gConfiguration.atDrvrVersNum < 53 then        { Check for AppleTalk phase 2. }
            begin
                StdAlert(phNoPhase2);
                ExitMacApp;
            end;
        FailOSErr(OpenDriver('.MPP',i));
        if OpenDriver('.DSP',gADSP) <> noErr then
            begin
                StdAlert(phNoADSP);
                ExitMacApp;
            end;

        { Set up the about box window. }
        gAboutWindow := NewTemplateWindow(kAboutWindow,nil);

        { Suppress dead-stripping of the following classes }
        if gDeadStripSuppression then
            begin
                if Member(TObject(nil), TMessagesWindow) then;
                if Member(TObject(nil), TNewWindow) then;
                if Member(TObject(nil), TStatusWindow) then;
                if Member(TObject(nil), TWindow) then;
                if Member(TObject(nil), TMessageListView) then;
            end;
    end;

{--------------------------------------------------------------------------------------------------}
{$S ARes}

procedure TLACSApplication.Terminate;
    { Clean up when application is terminated. }

    begin
        { Free all the documents. This is important since it'll force the net stuff to shut down. }
        gDocList.FreeAll;
        inherited Terminate;
    end;

{--------------------------------------------------------------------------------------------------}
{$S ARes}

procedure TLACSDocument.CheckFreeSpace;
    { Check the amount of free space available in memory, and free messages if necessary to make room. }

    var hRes: Handle;

    begin
        { Allocate our buffer zone. }
        hRes := NewHandle(kOurMemReserve);
        FailNil(hRes);
        { Free messages until we're down to safe(r) levels. }
        while MemSpaceIsLow and (fMessages.fSize > 0) do fMessages.At(1).Free;
        { Dispose of the buffer area. }
        DisposHandle(hRes);
    end;

{--------------------------------------------------------------------------------------------------}

{$S AClose}

procedure TLACSDocument.CloseView(aView: TView);
    { Close a window in the document. }

    begin
        { Ensure we close the window without closing the document. }
        if aView.fDocument = self then aView.Close;
    end;

{--------------------------------------------------------------------------------------------------}

{$S AOpen}

procedure TLACSDocument.DoInitialState;
        { Set up the initial state of the document. }

    begin
        with fConfig do
            begin
                { These are the default algorithm parameters. }
                inZoneSearch := 2;
                push := true;
                pull := false;
                pullOnLess := 5;
                count := true;
                countValue := 30;
                feedback := true;
                delayBase := 5;
                delayExp := 2;
                expireIn := 345600;        { 60*60*24*4 (four days) }
                defaultFilter := kNormalFilter;
                defaultType := kNormalType;
                forwarding := kForwardManually;
                signature := kSignatureFromChooser;
                userSignature := '';
            end;
        fUseDisplayState := false;
    end;

{--------------------------------------------------------------------------------------------------}

{$S AOpen}

procedure TLACSDocument.DoMakeViews(forPrinting: boolean);
    { Create views to display the document. }

    var p: Point;
        ds: TDocumentSaver;
        re: TMessagesExpirator;
        zl: TZoneLookup;
        nl: TNodeLookup;
        g: TGossip;

    begin
        { Actually, we use this method mainly to start up the periodic functions. This isn't very MacAppish, but...
            We need to have the windows around when reading in the document since we store some things
            (like the total messages seen count) directly in fields in the window, but we don't want to have
            periodic stuff going until everything else is fully set up. }

        { Document saver. }
        new(ds);
        FailNil(ds);
        ds.IDocumentSaver(self,kDocSaverInitial,kDocSaverInactive,kDocSaverActive);
        fDocumentSaver := ds;

        { Messages expirer. }
        new(re);
        FailNil(re);
        re.IMessagesExpirator(self,kExpirerInitial,kExpirerInactive,kExpirerActive);
        fMessagesExpirator := re;

        { Zone lookup. }
        new(zl);
        FailNil(zl);
        zl.IZoneLookup(self,kZoneLookupInitial,kZoneLookupInactive,kZoneLookupActive);
        fZoneLooker := zl;

        { Node lookup. }
        new(nl);
        FailNil(nl);
        nl.INodeLookup(self,kNodeLookupInitial,kNodeLookupFastInactive,kNodeLookupSlowInactive,kNodeLookupActive);
        fNodeLooker := nl;

        { Gossipee. }
        new(g);
        FailNil(g);
        g.IGossip(self,false,kGossipeeInitial,kGossipeeInactive,kGossipeeActive);
        fGossipee := g;

        { Gossiper. }
        new(g);
        FailNil(g);
        g.IGossip(self,true,kGossiperInitial,kGossiperInactive,kGossiperActive);
        fGossiper := g;

        { Set up windows according to the saved state. }
        if fUseDisplayState then
            begin
                p := fDisplayState.messagesWindPos;
                fMessagesWindow.Locate(p.h,p.v,false);
                fMessagesWindow.fNotify.SetState(fDisplayState.notifyOnNew,false);
                p := fDisplayState.newWindPos;
                fNewWindow.Locate(p.h,p.v,false);
                p := fDisplayState.statusWindPos;
                fStatusWindow.Locate(p.h,p.v,false);
                fStatusWindow.IncTotalMessages(fDisplayState.totalMessages);
                fStatusWindow.IncTotalPassed(fDisplayState.passedMessages);
            end;

        { Clear out any expired messages. }
        fNewWindow.ResetExpire;

        { Start out bored. }
        fStatusWindow.Bored;
    end;

{--------------------------------------------------------------------------------------------------}

{$S ARes}

function TLACSDocument.DoMenuCommand(aCmdNumber: CmdNumber): TCommand;
    { Handle menu commands. }

    begin
        DoMenuCommand := nil;
        { We only handle items in our menu. }
        case aCmdNumber of

            cMessagesWindow:
                begin
                    { Select it and bring it to the front. }
                    fMessagesWindow.Show(true,true);
                    fMessagesWindow.Select;
                end;

            cNewWindow:
                begin
                    { Select it and bring it to the front. }
                    fNewWindow.Show(true,true);
                    fNewWindow.Select;
                end;

            cStatusWindow:
                begin
                    { Select it and bring it to the front. }
                    fStatusWindow.Show(true,true);
                    fStatusWindow.Select;
                end;

            cMarkAllRead:
                begin
                    { Clear the current message display. }
                    fMessagesWindow.ClearCurrent;
                    { Then mark everything as read. }
                    MarkAllAsRead;
                end;

            cClearMessages:
                begin
                    { Clear the current message display. }
                    fMessagesWindow.ClearCurrent;
                    { Then delete all the messages. }
                    fMessages.FreeAll;
                end;

            cPreferences:
                begin
                    { Find out what the user would like as defaults. }
                    GetPreferences;
                end;

            { If it's not ours, let someone else handle it. }
            otherwise DoMenuCommand := inherited DoMenuCommand(aCmdNumber);
            end;
    end;

{--------------------------------------------------------------------------------------------------}

{$S AWriteFile}

procedure TLACSDocument.DoNeedDiskSpace(var dataForkBytes, rsrcForkBytes: longInt);
    { Computer how much disk space is needed to save the document to disk. }

    procedure addInOne(r: TMessage);
        { Compute the space for one message. }

        begin
            r.DoNeedDiskSpace(dataForkBytes,rsrcForkBytes);
        end;

    begin
        inherited DoNeedDiskSpace(dataForkBytes,rsrcForkBytes);
        dataForkBytes := dataForkBytes + sizeof(longInt) + sizeof(DisplayState) + sizeof(ConfigSettings) +
                                    sizeof(longInt) + fMessages.fSize;
        fMessages.Each(addInOne);
    end;

{--------------------------------------------------------------------------------------------------}

{$S AReadFile}

procedure TLACSDocument.DoRead(aRefNum: integer; rsrcExists, forPrinting: boolean);
    { Read the document from disk. }

    var dispRec: DisplayState;
        fileFormat: longInt;
        errRet: OSErr;
        nr: TMessage;
        l: longInt;
        n: longInt;
        i: longInt;
        s: longInt;
        h: Handle;
        config: ConfigSettings;

    begin
        { Get the file size. }
        FailOSErr(GetEOF(aRefNum,l));
        { If it's zero, don't try to read it. }
        if l = 0 then errRet := -1
        else
            begin
                { Otherwise, check the file format. }
                l := sizeof(fileFormat);
                errRet := FSRead(aRefNum,l,@fileFormat);
                if (errRet = noErr) and (fileFormat <> kSettingsVersion) then
                    begin
                        { If it's not what we're willing to parse, ask if we can erase it. }
                        if MacAppAlert(phInvalidSettings,nil) <> kYesButton then Failure(-1,0);
                        errRet := -1;
                    end;
            end;
        { If we don't have a good settings file, initialize from scratch. }
        if errRet <> noErr then
            begin
                { Show the disclaimers. }
                StdAlert(phLegal);
                DoInitialState;
            end
        { Otherwise, read it in from the file. }
        else
            begin
                inherited DoRead(aRefNum,rsrcExists,forPrinting);
                { Read the display state. }
                l := sizeof(dispRec);
                FailOSErr(FSRead(aRefNum,l,@dispRec));
                fDisplayState := dispRec;
                fUseDisplayState := true;
                { Read the configuration. }
                l := sizeof(config);
                FailOSErr(FSRead(aRefNum,l,@config));
                fConfig := config;
                { Read each of the messages. }
                l := sizeof(n);
                FailOSErr(FSRead(aRefNum,l,@n));
                for i := 1 to n do
                    begin
                        new(nr);
                        FailNil(nr);
                        nr.IMessageFromFile(self,aRefNum);
                    end;
            end;

        { Now expire any messages that need it. }
        ExpireMessages;
    end;

{--------------------------------------------------------------------------------------------------}

{$S ARes}

procedure TLACSDocument.DoSetupMenus;
    { Enable the appropriate menus. }

    begin
        inherited DoSetupMenus;
        Enable(cMessagesWindow,true);
        Enable(cNewWindow,true);
        Enable(cStatusWindow,true);
        Enable(cMarkAllRead,true);
        Enable(cClearMessages,true);
        Enable(cPreferences,true);
    end;

{--------------------------------------------------------------------------------------------------}

{$S AWriteFile}

procedure TLACSDocument.DoWrite(aRefNum: integer; makingCopy: boolean);
    { Write the document to disk. }

    var dispRec: DisplayState;
        fileFormat: longInt;
        errRet: OSErr;
        sr: SavedMessage;
        l: longInt;
        n: longInt;
        i: longInt;
        s: longInt;
        h: Handle;
        r: Rect;
        config: ConfigSettings;

    procedure saveOne(r: TMessage);
        { Write one message to disk. }

        begin
            r.WriteToFile(aRefNum);
        end;

    begin
        { Write file format. }
        fileFormat := kSettingsVersion;
        l := sizeof(fileFormat);
        FailOSErr(FSWrite(aRefNum,l,@fileFormat));
        inherited DoWrite(aRefNum,makingCopy);
        { Figure out the display state. }
        with dispRec do
            begin
                fMessagesWindow.GetGlobalBounds(r);
                messagesWindPos := r.topLeft;
                messagesWindShown := fMessagesWindow.IsShown;
                notifyOnNew := fMessagesWindow.fNotify.IsOn;
                fNewWindow.GetGlobalBounds(r);
                newWindPos := r.topLeft;
                newWindShown := fNewWindow.IsShown;
                fStatusWindow.GetGlobalBounds(r);
                statusWindPos := r.topLeft;
                statusWindShown := fStatusWindow.IsShown;
                totalMessages := fStatusWindow.fTotalMessages.GetValue;
                passedMessages := fStatusWindow.fTotalPassed.GetValue;
            end;
        { Write the display state. }
        l := sizeof(dispRec);
        FailOSErr(FSWrite(aRefNum,l,@dispRec));
        { Write the configuration. }
        config := fConfig;
        l := sizeof(config);
        FailOSErr(FSWrite(aRefNum,l,@config));
        { Write the message count. }
        n := fMessages.fSize;
        l := sizeof(n);
        FailOSErr(FSWrite(aRefNum,l,@n));
        { Write the messages. }
        fMessages.Each(saveOne);
    end;

{--------------------------------------------------------------------------------------------------}

{$S ARes}

procedure TLACSDocument.ExpireMessages;
    { Check for expired messages, and dump them if they are expired. }

    procedure expireOne(r: TMessage);
        { Check one message. }

        begin
            if Expired(r.fExpireDate) then r.Free;
        end;

    begin
        fMessages.Each(expireOne);
    end;

{--------------------------------------------------------------------------------------------------}

{$S AFields}

procedure TLACSDocument.Fields(procedure DoToField(fieldName: Str255; fieldAddr: Ptr;
                                    fieldType: integer));

    var s: Str255;

    begin
        DoToField('TLACSDocument', nil, bClass);
        DoToField('fMessages', @fMessages, bObject);
        DoToField('fMessagesWindow', @fMessagesWindow, bObject);
        DoToField('fNewWindow', @fNewWindow, bObject);
        DoToField('fStatusWindow', @fStatusWindow, bObject);
        DoToField('fDocumentSaver', @fDocumentSaver, bObject);
        DoToField('fMessagesExpirator', @fMessagesExpirator, bObject);
        DoToField('fZoneLooker', @fZoneLooker, bObject);
        DoToField('fNodeLooker', @fNodeLooker, bObject);
        DoToField('fGossiper', @fGossiper, bObject);
        DoToField('fGossipee', @fGossipee, bObject);
        DoToField('fConfig.inZoneSearch', @fConfig.inZoneSearch, bInteger);
        DoToField('fConfig.push', @fConfig.push, bBoolean);
        DoToField('fConfig.pull', @fConfig.pull, bBoolean);
        DoToField('fConfig.pullOnLess', @fConfig.pullOnLess, bInteger);
        DoToField('fConfig.count', @fConfig.count, bBoolean);
        DoToField('fConfig.countValue', @fConfig.countValue, bInteger);
        DoToField('fConfig.feedback', @fConfig.feedback, bBoolean);
        DoToField('fConfig.delayBase', @fConfig.delayBase, bLongInt);
        DoToField('fConfig.delayExp', @fConfig.delayExp, bLongInt);
        DoToField('fConfig.expireIn', @fConfig.expireIn, bLongInt);
        DoToField('fConfig.defaultFilter', @fConfig.defaultFilter, bString);
        DoToField('fConfig.defaultType', @fConfig.defaultType, bString);
        case fConfig.forwarding of
            kForwardManually: s := 'kForwardManually';
            kForwardIfSigned: s := 'kForwardIfSigned';
            kForwardAlways: s := 'kForwardAlways';
            end;
        DoToField('fConfig.forwarding', @s, bString);
        case fConfig.signature of
            kNoSignature: s := 'kNoSignature';
            kSignatureFromChooser: s := 'kSignatureFromChooser';
            kSignatureFromUser: s := 'kSignatureFromUser';
            end;
        DoToField('fConfig.signature', @s, bString);
        DoToField('fConfig.userSignature', @fConfig.userSignature, bString);
        DoToField('fUseDisplayState', @fUseDisplayState, bBoolean);
        DoToField('fDisplayState.messagesWindPos', @fDisplayState.messagesWindPos, bPoint);
        DoToField('fDisplayState.messagesWindShown', @fDisplayState.messagesWindShown, bBoolean);
        DoToField('fDisplayState.notifyOnNew', @fDisplayState.notifyOnNew, bBoolean);
        DoToField('fDisplayState.newWindPos', @fDisplayState.newWindPos, bPoint);
        DoToField('fDisplayState.newWindShown', @fDisplayState.newWindShown, bBoolean);
        DoToField('fDisplayState.statusWindPos', @fDisplayState.statusWindPos, bPoint);
        DoToField('fDisplayState.statusWindShown', @fDisplayState.statusWindShown, bBoolean);
        DoToField('fDisplayState.totalMessages', @fDisplayState.totalMessages, bLongInt);
        DoToField('fDisplayState.passedMessages', @fDisplayState.passedMessages, bLongInt);
        inherited Fields(DoToField);
    end;

{--------------------------------------------------------------------------------------------------}

{$S AFree}

procedure TLACSDocument.Free;
        { Free the document. }

    var ignore: OSErr;

    begin
        { Free all the messages, and the list itself. }
        fMessages.FreeList;
        { Free the periodic objects. }
        FreeIfObject(fDocumentSaver);
        FreeIfObject(fMessagesExpirator);
        FreeIfObject(fZoneLooker);
        FreeIfObject(fNodeLooker);
        FreeIfObject(fGossiper);
        FreeIfObject(fGossipee);
        { Free the windows. }
        FreeIfObject(fMessagesWindow);
        FreeIfObject(fNewWindow);
        FreeIfObject(fStatusWindow);
        inherited Free;
    end;

{--------------------------------------------------------------------------------------------------}

{$S ARes}

function TLACSDocument.GetHotMessage: TMessage;
    { Find a hot message, if there are any. }

    var hotness: integer;

    procedure checkForHot(r: TMessage);
        { Check the temperature of a message. }

        begin
            if r.IsHot and r.fForward then
                if (r.fBadPasses + r.fSuccessfulPasses) < hotness then
                    begin
                        GetHotMessage := r;
                        hotness := r.fBadPasses + r.fSuccessfulPasses;
                    end;
        end;

    begin
        { Find the hotest message there is. }
        hotness := 32000;
        GetHotMessage := nil;
        fMessages.Each(checkForHot);
    end;

{--------------------------------------------------------------------------------------------------}

{$S ARes}

procedure TLACSDocument.GetPreferences;
    { Query the user for his preferences. }

    var aWindow: TWindow;
        forwMan, forwSig, forwAll: TRadio;
        sigNone, sigChooser, sigUser: TRadio;
        sig: TEditText;
        s: Str255;

    begin
        { Get the dialog window. }
        aWindow := NewTemplateWindow(kPreferencesWindow, NIL);
        FailNIL(aWindow);

        { Find all the radio buttons and the TEditText. }
        forwMan := TRadio(aWindow.FindSubView('Manu'));
        forwSig := TRadio(aWindow.FindSubView('Auts'));
        forwAll := TRadio(aWindow.FindSubView('Auta'));
        sigNone := TRadio(aWindow.FindSubView('Nosi'));
        sigChooser := TRadio(aWindow.FindSubView('Sigc'));
        sigUser := TRadio(aWindow.FindSubView('Sigu'));
        sig := TEditText(aWindow.FindSubView('Sign'));

        { Set them to the current configuration. }
        forwMan.SetState(fConfig.forwarding = kForwardManually,false);
        forwSig.SetState(fConfig.forwarding = kForwardIfSigned,false);
        forwAll.SetState(fConfig.forwarding = kForwardAlways,false);
        sigNone.SetState(fConfig.signature = kNoSignature,false);
        sigChooser.SetState(fConfig.signature = kSignatureFromChooser,false);
        sigUser.SetState(fConfig.signature = kSignatureFromUser,false);
        s := fConfig.userSignature;
        sig.SetText(s,false);

        { Query the user, but only listen to the result if the user clicks on OK. }
        if TDialogView(aWindow.FindSubView('DLOG')).PoseModally = 'OKOK' then
            begin
                { Record the new configuration. }
                if forwMan.IsOn then fConfig.forwarding := kForwardManually
                else if forwSig.IsOn then fConfig.forwarding := kForwardIfSigned
                else if forwAll.IsOn then fConfig.forwarding := kForwardAlways;
                if sigNone.IsOn then fConfig.signature := kNoSignature
                else if sigChooser.IsOn then fConfig.signature := kSignatureFromChooser
                else if sigUser.IsOn then fConfig.signature := kSignatureFromUser;
                sig.GetText(s);
                fConfig.userSignature := s;
                fNewWindow.GetSignature;
            end;

        { Close the window and release it. }
        aWindow.Close;
    end;

{--------------------------------------------------------------------------------------------------}

{$S ARes}

function TLACSDocument.GetRandomMessage: TMessage;
    { Find a message at random. }

    begin
        if fMessages.fSize <= 0 then GetRandomMessage := nil
        else GetRandomMessage := TMessage(fMessages.At(abs(Random) mod fMessages.fSize + 1));
    end;

{--------------------------------------------------------------------------------------------------}

{$S ARes}

function TLACSDocument.GetMessage(f: Str32; t: Str32; h: Handle): TMessage;
    { Get the message that corresponds to the filter/type/handle given. }

    function eqMessage(r: TMessage): boolean;
        { Check if this is the message we're looking for. }

        var p1, p2: Ptr;
            sz: longInt;

        begin
            eqMessage := false;
            { Does it have the same type and filter? }
            if (f = r.fFilter) and (t = r.fType) then
                begin
                    { Does it have the same text? }
                    sz := GetHandleSize(h);
                    if sz = GetHandleSize(r.fText) then
                        begin
                            p1 := h^; p2 := r.fText^;
                            while sz > 0 do
                                begin
                                    if p1^ <> p2^ then exit(eqMessage);
                                    p1 := Ptr(ord4(p1)+1);
                                    p2 := Ptr(ord4(p2)+1);
                                    sz := sz-1;
                                end;
                            eqMessage := true;
                        end;
                end;
        end;

    begin
        GetMessage := TMessage(fMessages.FirstThat(eqMessage));
    end;

{--------------------------------------------------------------------------------------------------}

{$S ARes}

function TLACSDocument.HandleIncomingCommand(theData: Ptr; theSz: longInt): longInt;
    { Handle an incoming command. If there's a reply, put it into the same buffer and return the size. }

    var p: Ptr;
        h: Handle;
        cmd: Str255;
        messageFilter: Str255;
        messageType: Str255;
        sd: longInt;
        ed: longInt;
        i: integer;
        sz: longInt;
        answerSz: longInt;
        r: TMessage;

    procedure getNextString(var p: Ptr; var sz: longInt; var s: Str255; maxSize: integer);
        { Get the next string in the command. }

        var i: integer;
            pStart: Ptr;

        begin
            i := 0;
            pStart := p;
            while (sz > 0) and (p^ <> kTab) do
                begin
                    p := Ptr(ord4(p)+1);
                    sz := sz-1;
                    if i < maxSize then i := i+1;
                end;
            s[0] := chr(i);
            BlockMove(pStart,Ptr(ord4(@s)+1),i);
            while (sz > 0) and (p^ <> kTab) do
                begin
                    p := Ptr(ord4(p)+1);
                    sz := sz-1;
                end;
            if sz > 0 then
                begin
                    p := Ptr(ord4(p)+1);
                    sz := sz-1;
                end;
        end;

    function getNextHandle(var p: Ptr; var sz: longInt; maxSize: longInt): Handle;
        { Get the next handle (indefinite length string) in the command. }

        var pStart: Ptr;
            szToGet: longInt;

        begin
            pStart := p;
            while (sz > 0) and (p^ <> kTab) do
                begin
                    p := Ptr(ord4(p)+1);
                    sz := sz-1;
                end;
            szToGet := ord4(p)-ord4(pStart);
            if szToGet > maxSize then szToGet := maxSize;
            h := NewHandle(szToGet);
            if h <> nil then BlockMove(pStart,h^,szToGet);
            if p^ = kTab then
                begin
                    p := Ptr(ord4(p)+1);
                    sz := sz-1;
                end;
            getNextHandle := h;
        end;

    function getNextLong(var p: Ptr; var sz: longInt): longInt;
        { Get the next longInt in the command. }

        var s: Str255;
            l: longInt;

        begin
            getNextString(p,sz,s,255);
            StringToNum(s,l);
            getNextLong := l;
        end;

    begin
        sz := theSz;
        answerSz := 0;
        p := theData;
        h := nil;
        { Get the command. }
        getNextString(p,sz,cmd,255);
        { Check for a new message command. }
        if cmd = 'Rumor' then
            begin
                { Get the message. }
                getNextString(p,sz,messageFilter,32);
                getNextString(p,sz,messageType,32);
                h := getNextHandle(p,sz,kMaxMessageSize);
                if h <> nil then
                    begin
                        sd := getNextLong(p,sz);
                        if sd = 0 then sd := GetNow;
                        ed := getNextLong(p,sz);
                        { Have we heard it? }
                        r := GetMessage(messageFilter,messageType,h);
                        { If yes, then reply that it's cold. }
                        if r <> nil then cmd := 'ColdRumor'
                        { Otherwise remember it and reply that it's hot. }
                        else
                            begin
                                NewMessage(false,messageFilter,messageType,h,sd,ed,false);
                                cmd := 'HotRumor';
                            end;
                        { Build our answer. }
                        PutNextString(theData,answerSz,cmd);
                        PutNextString(theData,answerSz,messageFilter);
                        PutNextString(theData,answerSz,messageType);
                        PutNextHandle(theData,answerSz,h);
                    end;
            end
        { Check for cold message reply. }
        else if cmd = 'ColdRumor' then
            begin
                { Get the message. }
                getNextString(p,sz,messageFilter,32);
                getNextString(p,sz,messageType,32);
                h := getNextHandle(p,sz,kMaxMessageSize);
                { Find it and cool it off. }
                r := GetMessage(messageFilter,messageType,h);
                if r <> nil then r.FailedPass;
            end
        { Check for hot message reply. }
        else if cmd = 'HotRumor' then
            begin
                { Get the message. }
                getNextString(p,sz,messageFilter,32);
                getNextString(p,sz,messageType,32);
                h := getNextHandle(p,sz,kMaxMessageSize);
                { Find it and warm it up. }
                r := GetMessage(messageFilter,messageType,h);
                if r <> nil then r.SuccessfullPass;
            end
        { Check for a dump our parameters command. }
        else if cmd = 'DumpParams' then
            begin
                { Build a reply telling what our parameters are. }
                PutNextString(theData,answerSz,'Params');
                PutNextString(theData,answerSz,Concat(
                    'Version ',kApplicationVersion,
                    'InZoneSearch ',LongAsString(fConfig.inZoneSearch),
                    ' Push ',BoolAsString(fConfig.push),
                    ' Pull ',BoolAsString(fConfig.pull),
                    ' PullOnLess ',LongAsString(fConfig.pullOnLess),
                    ' Count ',BoolAsString(fConfig.count),
                    ' CountValue ',LongAsString(fConfig.countValue),
                    ' Feedback ',BoolAsString(fConfig.feedback),
                    ' DelayBase ',LongAsString(fConfig.delayBase),
                    ' DelayExp ',LongAsString(fConfig.delayExp)));
            end
        { Check for a pull command. }
        else if cmd = 'Pull' then
            begin
                { Get a message and return it. }
                r := GetHotMessage;
                if r <> nil then answerSz := r.BuildMessageCommand(theData);
            end
        { Check for a pull-even-if-it's-cold command. }
        else if cmd = 'PullCold' then
            begin
                { Get a message, any message, and return it. }
                r := GetHotMessage;
                if r = nil then r := GetRandomMessage;
                if r <> nil then
                    if not r.fForward then r := nil;
                if r <> nil then answerSz := r.BuildMessageCommand(theData);
            end;
        { If we've built a reply, terminate it with the return. }
        if answerSz > 0 then
            begin
                theData^ := kReturn;
                answerSz := answerSz+1;
            end;
        if h <> nil then DisposHandle(h);
        HandleIncomingCommand := answerSz;
    end;

{--------------------------------------------------------------------------------------------------}

{$S AInit}

procedure TLACSDocument.ILACSDocument;
    { Intialize the document. }

    begin
        IDocument(kLACSSettings, kSignature, kUsesDataFork, NOT kUsesRsrcFork, kDataOpen, NOT kRsrcOpen);

        { We make the windows here instead of in DoMakeView/Windows because we keep some of the model
            information in window objects, so we need them around when we're reading in the document. }
        fMessagesWindow := TMessagesWindow(NewTemplateWindow(kMessagesWindow,self));
        fMessagesWindow.FindSubviews;
        fNewWindow := TNewWindow(NewTemplateWindow(kNewWindow,self));
        fNewWindow.FindSubviews;
        fStatusWindow := TStatusWindow(NewTemplateWindow(kStatusWindow,self));
        fStatusWindow.FindSubviews;


        { Clear out the periodic functions. }
        fDocumentSaver := nil;
        fMessagesExpirator := nil;
        fZoneLooker := nil;
        fNodeLooker := nil;
        fGossiper := nil;
        fGossipee := nil;

        { Init the message list. }
        fMessages := NewList;
    end;

{--------------------------------------------------------------------------------------------------}

{$S ARes}

procedure TLACSDocument.MarkAllAsRead;
    { Mark all messages as read. }

    procedure markOne(r: TMessage);
        { Mark one message as read. }

        begin
            r.MarkAsRead;
        end;

    begin
        fMessagesWindow.fUnread.Each(markOne);
    end;

{--------------------------------------------------------------------------------------------------}

{$S ARes}

procedure TLACSDocument.NewMessage(ru: boolean; f: Str32; t: Str32; h: Handle; sd: longInt; ed: longInt;
                                                                alwaysForward: boolean);
    { Enter a new message into the document. }

    var nr: TMessage;

    begin
        { Only record it is it hasn't already expired. }
        if (not Expired(ed)) and (GetHandleSize(h) > 0) then
            begin
                { Notify the user. }
                fMessagesWindow.Notify;
                fStatusWindow.SetStatus(kStatNewMessage);
                { Create the message. }
                new(nr);
                FailNil(nr);
                nr.IMessage(self, ru, f, t, h, sd, ed);
                if alwaysForward then nr.fForward := true;
                fStatusWindow.IncTotalMessages(1);
                { Get the gossiper moving if he isn't already. }
                fGossiper.Kick;
            end;
    end;

{--------------------------------------------------------------------------------------------------}

{$S ARes}

procedure TLACSDocument.ParseAsParams(h: Handle);
    { Interpret the data in the handle as a configuration setting string. }

    var p: Ptr;
        sz: longInt;
        s: Str255;

    procedure nextWord;
        { Return the next word in the input. }

        var strt: Ptr;
            l: longInt;

        begin
            while p^ = ord(' ') do
                begin
                    p := Ptr(ord4(p)+1);
                    sz := sz-1;
                end;
            strt := p;
            while (sz > 0) and (p^ <> ord(' ')) do
                begin
                    p := Ptr(ord4(p)+1);
                    sz := sz-1;
                end;
            l := ord4(p)-ord4(strt);
            if l > 255 then l := 255;
            s[0] := chr(l);
            BlockMove(strt,Ptr(ord4(@s)+1),l);
        end;

    function nextInt: integer;
        { Return the next longInt in the input. }

        var l: longInt;

        begin
            nextWord;
            StringToNum(s,l);
            nextInt := l;
        end;

    function nextBool: boolean;
        { Return the next boolean in the input. }

        begin
            nextWord;
            nextBool := s = 'true';
        end;

    begin
        { Cycle through the input, settings parameters as indicated. }
        p := h^;
        sz := GetHandleSize(h);
        while sz > 0 do
            begin
                nextWord;
                if s = 'InZoneSearch' then fConfig.inZoneSearch := nextInt
                else if s = 'Push' then fConfig.push := nextBool
                else if s = 'Pull' then fConfig.pull := nextBool
                else if s = 'PullOnLess' then fConfig.pullOnLess := nextInt
                else if s = 'Count' then fConfig.count := nextBool
                else if s = 'CountValue' then fConfig.countValue := nextInt
                else if s = 'Feedback' then fConfig.feedback := nextBool
                else if s = 'DelayBase' then fConfig.delayBase := nextInt
                else if s = 'DelayExp' then fConfig.delayExp := nextInt
                else nextWord;
            end;
    end;

{--------------------------------------------------------------------------------------------------}

{$S AOpen}

procedure TLACSDocument.ShowWindows;
    { Display windows (or not) as appropriate. }

    begin
        { First, make sure we've got our memory allocation in hand. }
        CheckFreeSpace;
        { Calculate the current signature. }
        fNewWindow.GetSignature;
        {Open up the windows. }
        fStatusWindow.Open;
        fNewWindow.Open;
        fMessagesWindow.Open;
        if fUseDisplayState then
            begin
                if fDisplayState.statusWindShown then fStatusWindow.Select
                else fStatusWindow.Show(false,false);
                if fDisplayState.newWindShown then fNewWindow.Select
                else fNewWindow.Show(false,false);
                if fDisplayState.messagesWindShown then fMessagesWindow.Select
                else fMessagesWindow.Show(false,false);
            end
        else
            begin
                fStatusWindow.Select;
                fNewWindow.Select;
                fMessagesWindow.Select;
            end;
    end;

{--------------------------------------------------------------------------------------------------}

{$S ARes}

procedure TMessage.AsString(var aString: Str255);
    { Return a string that represents the message (for display lists). }

    var h: Handle;
        l: longInt;

    begin
        h := fText;
        { Figure out the size. }
        l := GetHandleSize(h)+2;
        if l > 255 then l := 255;
        aString[0] := chr(l);
        { Mark it as hot or cold. }
        if fHot then aString[1] := '◊'
        else aString[1] := ' ';
        aString[2] := ' ';
        { Fill in the text. }
        BlockMove(h^,Ptr(ord4(@aString)+3),l-2);
    end;

{--------------------------------------------------------------------------------------------------}

{$S ARes}

function TMessage.BuildMessageCommand(var theData: Ptr): longInt;
    { Build a message command into the buffer pointed to by theData, incrementing theData as we go,
        and return the size of the command built. }

    var sz: longInt;
     t, f: Str32;

    begin
        sz := 0;
        { Put in command name. }
        PutNextString(theData,sz,'Rumor');
        { Put in parameters. }
        f := fFilter;
        PutNextString(theData,sz,f);
        t := fType;
        PutNextString(theData,sz,t);
        PutNextHandle(theData,sz,fText);
        PutNextString(theData,sz,LongAsString(fStartDate));
        PutNextString(theData,sz,LongAsString(fExpireDate));
        { Terminate it with a return. }
        theData^ := kReturn;
        sz := sz+1;
        buildMessageCommand := sz;
    end;

{--------------------------------------------------------------------------------------------------}

{$S AWriteFile}

procedure TMessage.DoNeedDiskSpace(var dataForkBytes, rsrcForkBytes: longInt);
    { Return the amount of disk space needed to save this message. }

    begin
        dataForkBytes := dataForkBytes + sizeof(SavedMessage) + sizeof(longInt) + GetHandleSize(fText);
    end;

{--------------------------------------------------------------------------------------------------}

{$S ARes}

procedure TMessage.FailedPass;
    { Factor in one more bad pass attempt. }

    begin
        fBadPasses := fBadPasses+1;
        UpdateHotness;
    end;

{--------------------------------------------------------------------------------------------------}

{$S AFields}

procedure TMessage.Fields(procedure DoToField(fieldName: Str255; fieldAddr: Ptr;
                                        fieldType: integer));

    begin
        DoToField('TMessage', nil, bClass);
        DoToField('fDocument', @fDocument, bObject);
        DoToField('fHot', @fHot, bBoolean);
        DoToField('fSuccessfulPasses', @fSuccessfulPasses, bInteger);
        DoToField('fBadPasses', @fBadPasses, bInteger);
        DoToField('fFilter', @fFilter, bString);
        DoToField('fType', @fType, bString);
        DoToField('fText', @fText, bHandle);
        DoToField('fStartDate', @fStartDate, bLongInt);
        DoToField('fExpireDate', @fExpireDate, bLongInt);
        DoToField('fLastMessaged', @fLastMessaged, bLongInt);
        DoToField('fForward', @fForward, bBoolean);
        inherited Fields(DoToField);
    end;

{--------------------------------------------------------------------------------------------------}

{$S AFree}

procedure TMessage.Free;
    { Free the message object. }

    begin
        { Get us out of the main message list. }
        fDocument.fMessages.Delete(self);
        { And out of the display lists. }
        fDocument.fMessagesWindow.fUnread.Delete(self);
        fDocument.fMessagesWindow.fRead.Delete(self);
        { Factor us out of the hot/cold statistics. }
        if fHot then fDocument.fStatusWindow.IncHotMessages(-1)
        else fDocument.fStatusWindow.IncColdMessages(-1);
        { Dispose of the body. }
        DisposHandle(fText);
        { Dispose of everything else. }
        inherited Free;
    end;

{--------------------------------------------------------------------------------------------------}

{$S ARes}

procedure TMessage.IMessage(aDoc: TLACSDocument; isRead: boolean; f: Str32; t: Str32; newText: Handle; sd: longInt; ed: longInt);
    { Initialize a message object. }

    var h: Handle;
        p: Ptr;
        sz: longInt;

    function containsSignature: boolean;

        var p: Ptr;
            sz: longInt;

        begin
            containsSignature := false;
            p := newText^;
            sz := GetHandleSize(newText);
            while sz > 0 do
                begin
                    if p^ = ord(kSignatureSeparator) then
                        begin
                            containsSignature := true;
                            leave;
                        end;
                    p := Ptr(ord4(p)+1);
                    sz := sz-1;
                end;
        end;

    begin
        IObject;
        { Remember the document we're attached to. }
        fDocument := aDoc;
        { Duplicate the body of the message. }
        h := newText;
        if HandToHand(h) <> noErr then h := NewHandle(0);
        FailNil(h);
        if GetHandleSize(h) > kMaxMessageSize then SetHandleSize(h,kMaxMessageSize);
        { Eliminate any tabs or returns from it (they shouldn't be there anyway, but we're paranoid. }
        p := h^;
        sz := GetHandleSize(h);
        while sz > 0 do
            begin
                if (p^ = kTab) or (p^ = kReturn) then p^ := ord(' ');
                p := Ptr(ord4(p)+1);
                sz := sz-1;
            end;
        { Insert ourselves into the main message list. }
        aDoc.fMessages.InsertLast(self);
        { Start out hot. }
        fHot := true;
        aDoc.fStatusWindow.IncHotMessages(1);
        { Start out unpassed. }
        fSuccessfulPasses := 0;
        fBadPasses := 0;
        { Remember the filter, type, body, and dates. }
        fFilter := f;
        fType := t;
        fText := h;
        fStartDate := sd;
        fExpireDate := ed;
        { Start remessage timer. }
        fLastMessaged := GetNow;
        { Decide how to forward. }
        if aDoc.fConfig.forwarding = kForwardManually then fForward := false;
        if aDoc.fConfig.forwarding = kForwardAlways then fForward := true
        else fForward := containsSignature;
        { Decide if we should display the message for the user. }
        if f = aDoc.fConfig.defaultFilter then
            begin
                { If yes, then display it in one of the two lists: read or unread. }
                if isRead then aDoc.fMessagesWindow.fRead.Insert(self)
                else aDoc.fMessagesWindow.fUnread.Insert(self);
            end;
        { If this is a parameter message, then process the parameters. }
        if t = 'Params' then ParseAsParams;
        { Tweak our free space. }
        aDoc.CheckFreeSpace;
    end;

{--------------------------------------------------------------------------------------------------}

{$S AReadFile}

procedure TMessage.IMessageFromFile(aDoc: TLACSDocument; aRefNum: integer);
    { Initialize a message object from a file. }

    var sr: SavedMessage;
        l: longInt;
        s: longInt;
        h: Handle;

    begin
        { Get the saved message info (everything but the body). }
        l := sizeof(sr);
        FailOSErr(FSRead(aRefNum,l,@sr));
        { Get the size of the body. }
        l := sizeof(s);
        FailOSERR(FSRead(aRefNum,l,@s));
        { Allocate and read the body of the message. }
        h := NewHandle(s);
        FailNil(h);
        HLock(h);
        FailOSErr(FSRead(aRefNum,s,h^));
        HUnlock(h);
        { Initialize the message. }
        IMessage(aDoc, sr.inReadList, sr.filter, sr.rType, h, sr.startDate, sr.expireDate);
        { Set it's hotness, passes, and last messaged fields. }
        fHot := sr.hot;
        if not sr.hot then
            begin
                aDoc.fStatusWindow.IncHotMessages(-1);
                aDoc.fStatusWindow.IncColdMessages(1);
            end;
        fSuccessfulPasses := sr.successfulPasses;
        fBadPasses := sr.badPasses;
        fLastMessaged := sr.lastMessaged;
        fForward := sr.forward;
        { Free our copy of the body (IMessage makes its own copy). }
        DisposHandle(h);
    end;

{--------------------------------------------------------------------------------------------------}

{$S ARes}

function TMessage.IsHot: boolean;
    { Return true if this message is still hot, and if enough time has passed for it to be spread again. }

    var l: longInt;
        age: longInt;

    begin
        { Assume it's not hot. }
        IsHot := false;
        { First off, it must actually be hot. }
        if fHot then
            begin
                { Second, enough time must have passed. }
                age := fDocument.fConfig.delayBase * fBadPasses;
                for l := 1 to fDocument.fConfig.delayExp-1 do age := age * fDocument.fConfig.delayBase * fBadPasses;
                if GetNow > (fLastMessaged + age) then IsHot := true;
            end;
    end;

{--------------------------------------------------------------------------------------------------}

{$S ARes}

procedure TMessage.MarkAsRead;
    { Mark this message as read. }

    begin
        { Take it out of the unread list. }
        fDocument.fMessagesWindow.fUnread.Delete(self);
        { Put it into the read list, if it isn't already there. }
        if fDocument.fMessagesWindow.fRead.GetSameItemNo(self) = kEmptyIndex then
            fDocument.fMessagesWindow.fRead.Insert(self);
    end;

{--------------------------------------------------------------------------------------------------}

{$S ARes}

procedure TMessage.ParseAsParams;
    { Parse ourself as algorithm parameters. }

    begin
        { Just let the document do all the work. }
        fDocument.ParseAsParams(fText);
    end;

{--------------------------------------------------------------------------------------------------}

{$S ARes}

procedure TMessage.SuccessfullPass;
    { Factor in one more successfull pass. }

    begin
        fDocument.fStatusWindow.IncTotalPassed(1);
        fSuccessfulPasses := fSuccessfulPasses+1;
        UpdateHotness;
    end;

{--------------------------------------------------------------------------------------------------}

{$S ARes}

procedure TMessage.UpdateHotness;
    { Update the temperature of this message. }

    var bad: integer;

    begin
        { Update when we last messaged -- this is only called after a message attempt. }
        fLastMessaged := GetNow;
        { If we're hot now, see if we've cooled off. }
        if fHot then
            begin
                { Figure out how many bad passes we think there's been. }
                bad := fBadPasses;
                { If we're not using feedback, then count successfull passes as bad. }
                if not fDocument.fConfig.feedback then bad := bad + fSuccessfulPasses;
                { Deterministic? }
                if fDocument.fConfig.count then
                    begin
                        if bad > fDocument.fConfig.countValue then fHot := false;
                    end
                { ... or statictical? }
                else
                    begin
                        if (abs(Random) mod fDocument.fConfig.countValue) = 0 then fHot := false;
                    end;
                { If we've cooled off, then update the lists and the statistics. }
                if not fHot then
                    begin
                        fDocument.fMessagesWindow.fUnread.Invalidate(self);
                        fDocument.fMessagesWindow.fRead.Invalidate(self);
                        fDocument.fStatusWindow.IncHotMessages(-1);
                        fDocument.fStatusWindow.IncColdMessages(1);
                    end;
            end;
    end;

{--------------------------------------------------------------------------------------------------}

{$S AWriteFile}

procedure TMessage.WriteToFile(aRefNum: integer);
    { Save this message to disk. }

    var sr: SavedMessage;
        l: longInt;
        n: longInt;
        h: Handle;
        fi: FailInfo;

    procedure hdlFailure(error: OSErr; message: LongInt);
        { If we fail, unlock the handle. }

        begin
            HUnlock(h);
        end;

    begin
        { Fill in the non-body part of the save. }
        with sr do
            begin
                hot := fHot;
                successfulPasses := fSuccessfulPasses;
                badPasses := fBadPasses;
                filter := fFilter;
                rType := fType;
                startDate := fStartDate;
                expireDate := fExpireDate;
                lastMessaged := fLastMessaged;
                forward := fForward;
                inReadList := fDocument.fMessagesWindow.fRead.GetSameItemNo(self) <> kEmptyIndex;
            end;
        { Save it. }
        l := sizeof(sr);
        FailOSErr(FSWrite(aRefNum,l,@sr));
        { Write the size of the body. }
        l := sizeof(n);
        h := fText;
        n := GetHandleSize(h);
        FailOSERR(FSWrite(aRefNum,l,@n));
        { Write the body itself. }
        HLock(h);
        CatchFailures(fi,hdlFailure);
        FailOSErr(FSWrite(aRefNum,n,h^));
        Success(fi);
        HUnlock(h);
    end;

{--------------------------------------------------------------------------------------------------}

{$S ARes}

procedure TDisplayList.AtDelete(index: ArrayIndex);
    { Delete the entry at index. }

    begin
        { If it's currently in the full display, clear that. }
        if fView.IsItemSelected(index) then fDocument.fMessagesWindow.ClearCurrent;
        { Delete it from the displayed list. }
        fView.DelItemAt(index,1);
        { Delete it from our list. }
        inherited AtDelete(index);
    end;

{--------------------------------------------------------------------------------------------------}

{$S ARes}

function TDisplayList.Compare(item1, item2: TObject): CompareResult;
    { Compare two objects. }

    begin
        { Compare by origination date. }
        if TMessage(item1).fStartDate > TMessage(item2).fStartDate then Compare := kItem1GreaterThanItem2
        else if TMessage(item1).fStartDate < TMessage(item2).fStartDate then Compare := kItem1LessThanItem2
        else Compare := kItem1EqualItem2;
    end;

{--------------------------------------------------------------------------------------------------}

{$S AFields}

procedure TDisplayList.Fields(procedure DoToField(fieldName: Str255; fieldAddr: Ptr;
                                        fieldType: integer)); override;

    begin
        DoToField('TDisplayList', nil, bClass);
        DoToField('fDocument', @fDocument, bObject);
        DoToField('fView', @fView, bObject);
        inherited Fields(DoToField);
    end;

{--------------------------------------------------------------------------------------------------}

{$S ARes}

procedure TDisplayList.FreeAll;
    { Free everything. }

    begin
        { Clear out the view. }
        fView.DelItemFirst(fView.fNumOfRows);
        { Clear out the list. }
        inherited FreeAll;
    end;

{--------------------------------------------------------------------------------------------------}

{$S AInit}

procedure TDisplayList.IDisplayList(theDoc: TLACSDocument; theView: TMessageListView);
    { Initialize the list. }

    begin
        ISortedList;
        fDocument := theDoc;
        fView := theView;
        theView.fList := self;
    end;

{--------------------------------------------------------------------------------------------------}

{$S ARes}

procedure TDisplayList.Insert(item: TObject);
    { Insert an item into the list. }

    var index: ArrayIndex;

    {$Push} {$IFC qTrace} {$D+} {$ENDC}

    function TestItem(anItem: TObject): CompareResult;

        begin
            if qDebug then FailNonObject(anItem);
            TestItem := Compare(item, anItem);
        end;
    {$Pop}

    begin
        if qDebug then FailNonObject(item);

        if DoSearch(TestItem, index) <> nil then;            { Discard result. }
        InsertBefore(index, item);
        fView.InsItemBefore(index,1);
    end;

{--------------------------------------------------------------------------------------------------}

{$S ARes}

procedure TDisplayList.Invalidate(o: TObject);
    { Invalidate the displayed object. }

    var n: ArrayIndex;

    begin
        n := GetSameItemNo(o);
        if n <> kEmptyIndex then fView.InvalidateItem(n);
    end;

{--------------------------------------------------------------------------------------------------}

{$S ARes}

procedure TDisplayList.Select(o: TObject);
    { Select the displayed object. }

    begin
        fView.SelectItem(GetSameItemNo(o),false,true,true);
        fView.ScrollSelectionIntoView(true);
    end;

{--------------------------------------------------------------------------------------------------}

{$S ARes}

procedure TMessagesWindow.ClearCurrent;
    { Clear out the selected message display. }

    begin
        fRead.fView.SetEmptySelection(false);
        fShow.SetText('');
        fShow.ShowReverted;
        fOriginated.SetText('',true);
        fExpires.SetText('',true);
        fForward.SetState(false,true);
    end;

{--------------------------------------------------------------------------------------------------}

{$S ARes}

procedure TMessagesWindow.DisplayMessage(r: TMessage);
    { Display message r. }

    var h: Handle;
        s, s2: Str255;

    begin
        { Show the text body. }
        h := r.fText;
        FailOSErr(HandToHand(h));
        fShow.StuffText(h);
        fShow.ShowReverted;
        { Show the origination date. }
        IUDateString(r.fStartDate,abbrevDate,s);
        Delete(s,1,5);
        IUTimeString(r.fStartDate,false,s2);
        fOriginated.SetText(Concat(s,'  ',s2),true);
        { Show the expiration date. }
        IUDateString(r.fExpireDate,AbbrevDate,s);
        Delete(s,1,5);
        IUTimeString(r.fExpireDate,false,s2);
        s := Concat(s,'  ',s2);
        fExpires.SetText(s,true);
        fForward.SetState(r.fForward,true);
        { Select the line in the read message list. }
        fRead.Select(r);
    end;

{--------------------------------------------------------------------------------------------------}

{$S ARes}

procedure TMessagesWindow.DoChoice(origView: TView; itsChoice: integer);
    { Handle button hits, etc. }

    var ourDoc: TLACSDocument;
        i: integer;
        r: TMessage;

    begin
        { Send Message? }
        if origView = fForward then
            begin
                i := fRead.fView.FirstSelectedItem;
                if i > 0 then r := TMessage(fRead.At(i));
                if r <> nil then r.fForward := fForward.IsOn;
            end
        { Otherwise, let the defaults have it. }
        else inherited DoChoice(origView,itsChoice);
    end;

{--------------------------------------------------------------------------------------------------}

{$S AFields}

procedure TMessagesWindow.Fields(procedure DoToField(fieldName: Str255; fieldAddr: Ptr;
                                        fieldType: integer)); override;

    begin
        DoToField('TMessagesWindow', nil, bClass);
        DoToField('fNotification', @fNotification, bPointer);
        DoToField('fUnread', @fUnread, bObject);
        DoToField('fNotify', @fNotify, bObject);
        DoToField('fRead', @fRead, bObject);
        DoToField('fShow', @fShow, bObject);
        DoToField('fOriginated', @fOriginated, bObject);
        DoToField('fExpires', @fExpires, bObject);
        inherited Fields(DoToField);
    end;

{--------------------------------------------------------------------------------------------------}

{$S AInit}

procedure TMessagesWindow.FindSubviews;
    { Lookup all our subviews for later. }

    var dl: TDisplayList;

    begin
        fNotification := Pointer(NewPtr(sizeof(NMRec)));
        FailNil(fNotification);
        new(dl);
        FailNil(dl);
        dl.IDisplayList(TLACSDocument(fDocument),TMessageListView(FindSubView('Unre')));
        dl.FreeAll;
        fUnread := dl;
        fNotify := TCheckBox(FindSubView('Noti'));
        new(dl);
        FailNil(dl);
        dl.IDisplayList(TLACSDocument(fDocument),TMessageListView(FindSubView('Read')));
        dl.FreeAll;
        fRead := dl;
        fShow := TTEView(FindSubView('Show'));
        fOriginated := TStaticText(FindSubView('Orig'));
        fExpires := TStaticText(FindSubView('Expi'));
        fForward := TCheckBox(FindSubView('Forw'));
    end;

{--------------------------------------------------------------------------------------------------}

{$S ARes}

procedure TMessagesWindow.Free;
    { Free the window. }

    var ignore: OSErr;

    begin
        ignore := NMRemove(QElemPtr(fNotification));
        DisposPtr(Ptr(fNotification));
        inherited Free;
    end;

{--------------------------------------------------------------------------------------------------}

{$S ARes}

procedure TMessagesWindow.KillNotify;
    { Take away the Notification Manager notification. }

    var ignore: OSErr;

    begin
        ignore := NMRemove(QElemPtr(fNotification));
    end;

{--------------------------------------------------------------------------------------------------}

{$S ARes}

procedure TMessagesWindow.Notify;
    { Notify the user via the Notification Manager. }

    var ignore: OSErr;

    begin
        { Only notify if we're in the background and the user wants it. }
        if fNotify.IsOn and gInBackground then
            begin
                ignore := NMRemove(QElemPtr(fNotification));
                with fNotification^ do
                    begin
                        qType := nmType;        { Queue type -- nmType = 8. }
                        nmMark := 1;             { Get mark in Apple menu. }
                        nmSIcon := GetResource('SICN',kMySmallIcon);    { Flashing Icon. }
                        nmSound := nil;            { No sound to be played. }
                        nmStr := nil;            { No alert box. }
                        nmResp := nil;            { No response procedure. }
                        nmRefCon := 0;            { Set to nil since we don't need A5. }
                    end;
                ignore := NMInstall(QElemPtr(fNotification));
            end;
    end;

{--------------------------------------------------------------------------------------------------}

{$S ARes}

procedure TNewWindow.DoChoice(origView: TView; itsChoice: integer);
    { Handle button hits, etc. }

    var ourDoc: TLACSDocument;
        f, t: Str32;
        h: Handle;
        s: Str255;

    begin
        { Send Message? }
        if origView = fSpread then
            begin
                { Ask the user if he's really really sure he wants to post this one. }
                if MacAppAlert(phAreYouSure,nil) = kYesButton then
                    begin
                        { Create a new message. }
                        ourDoc := TLACSDocument(fDocument);
                        f := ourDoc.fConfig.defaultFilter;
                        t := ourDoc.fConfig.defaultType;
                        h := fInput.ExtractText;
                        { But only if there's something to say. }
                        if GetHandleSize(h) > 0 then
                            begin
                                FailOSErr(HandToHand(h));
                                { Add in the signature. }
                                fSignature.GetText(s);
                                if s <> '' then s := Concat(' ',kSignatureSeparator,' ',s);
                                FailOSErr(PtrAndHand(Ptr(ord4(@s)+1),h,length(s)));
                                { Post the message. }
                                ourDoc.NewMessage(true,f,t,h,GetNow,GetExpire,true);
                                DisposHandle(h);
                                { Clear out the input area. }
                                fInput.StuffText(NewHandle(0));
                                fInput.ShowReverted;
                            end;
                    end;
            end
        { Expiration date change? }
        else if (origView = fMonth) or (origView = fDay) then GetSetExpire
        { Otherwise, let the defaults have it. }
        else inherited DoChoice(origView,itsChoice);
    end;

{--------------------------------------------------------------------------------------------------}

{$S ARes}

function TNewWindow.DoKeyCommand(ch: char; aKeyCode: integer;
                                                                      var info: EventInfo): TCommand; override;
    { Handle keyboard events. }

    begin
        { Ignore carriage returns. }
        if ch = chReturn then DoKeyCommand := gNoChanges
        { Enter is the same as a Send Message click. }
        else if ch = chEnter then
            begin
                DoChoice(fSpread,mButtonHit);
                DoKeyCommand := gNoChanges;
            end
        { Otherwise, let MacApp do it. }
        else DoKeyCommand := inherited DoKeyCommand(ch, aKeyCode, info);
    end;

{--------------------------------------------------------------------------------------------------}

{$S ARes}

function TNewWindow.ExpireExpired: boolean;
    { Check if we need to reset the expiration date. }

    var dt: DateTimeRec;
        s: Str255;
        l, l2: longInt;

    begin
        { See if we're into a new day. }
        Secs2Date(GetNow+TLACSDocument(fDocument).fConfig.expireIn,dt);
        dt.hour := 0;
        dt.minute := 0;
        dt.second := 0;
        Date2Secs(dt,l);
        with dt do
            begin
                fYear.GetText(s);
                StringToNum(Copy(s,3,4),l2);
                dt.year := l2;
                month := fMonth.GetCurrentItem;
                day := fDay.GetCurrentItem;
                hour := 0;
                minute := 0;
                second := 0;
            end;
        Date2Secs(dt,l2);
        ExpireExpired := l <> l2;
    end;

{--------------------------------------------------------------------------------------------------}

{$S AFields}

procedure TNewWindow.Fields(procedure DoToField(fieldName: Str255; fieldAddr: Ptr;
                                        fieldType: integer)); override;

    begin
        DoToField('TStatusWindow', nil, bClass);
        DoToField('fInput', @fInput, bObject);
        DoToField('fSpread', @fSpread, bObject);
        DoToField('fMonth', @fMonth, bObject);
        DoToField('fDay', @fDay, bObject);
        DoToField('fYear', @fYear, bObject);
        DoToField('fSignature', @fSignature, bObject);
        inherited Fields(DoToField);
    end;

{--------------------------------------------------------------------------------------------------}

{$S AInit}

procedure TNewWindow.FindSubviews;
    { Lookup all our subviews for later. }

    begin
        fInput := TTEView(FindSubView('Inpu'));
        fInput.fControlChars := fInput.fControlChars - [chReturn];
        fSpread := TButton(FindSubView('Spre'));
        fMonth := TPopup(FindSubView('Mont'));
        fDay := TPopup(FindSubView('Day '));
        fYear := TStaticText(FindSubView('Year'));
        fSignature := TStaticText(FindSubView('Sign'));
    end;

{--------------------------------------------------------------------------------------------------}

{$S ARes}

function TNewWindow.GetExpire: longInt;
    { Get the expiration date. }

    var dt: DateTimeRec;
        l: longInt;

    begin
        { Compute the expiration date (remember, we expire at 5AM). }
        Secs2Date(GetNow,dt);
        with dt do
            begin
                month := fMonth.GetCurrentItem;
                day := fDay.GetCurrentItem;
                hour := 5;
                minute := 0;
                second := 0;
            end;
        Date2Secs(dt,l);
        if (l - GetNow) < 0 then
            begin
                dt.year := dt.year+1;
                Date2Secs(dt,l);
            end;
        GetExpire := l;
    end;

{--------------------------------------------------------------------------------------------------}

{$S ARes}

procedure TNewWindow.GetSetExpire;
    { Get and set the expiration date (corrects for odd month/day combinations, etc. }

    begin
        SetExpire(GetExpire);
    end;

{--------------------------------------------------------------------------------------------------}

{$S ARes}

procedure TNewWindow.GetSignature;
    { Figure out the current signature. }

    var ourDoc: TLACSDocument;
        s: Str255;
        zoneStr: Str32;

    begin
        ourDoc := TLACSDocument(fDocument);
        case ourDoc.fConfig.signature of
            kSignatureFromChooser: s := GetString(kChooserName)^^;
            kSignatureFromUser: s := ourDoc.fConfig.userSignature;
            otherwise s := '';
            end;
        if s <> '' then
            begin
                zoneStr := ourDoc.fZoneLooker.fOurZone;
                if zoneStr <> '' then s := Concat(s,' @ ',zoneStr);
            end;
        fSignature.SetText(s,true);
    end;

{--------------------------------------------------------------------------------------------------}

{$S ARes}

procedure TNewWindow.ResetExpire;
    { Reset the expiration date display. }

    var l: longInt;
        dt: DateTimeRec;

    begin
        Secs2Date(GetNow+TLACSDocument(fDocument).fConfig.expireIn,dt);
        Date2Secs(dt,l);
        SetExpire(l);
    end;

{--------------------------------------------------------------------------------------------------}

{$S ARes}

procedure TNewWindow.ResetIfExpired;
    { Reset the expiration date if the current one is expired. }

    begin
        if ExpireExpired then ResetExpire;
    end;

{--------------------------------------------------------------------------------------------------}

{$S ARes}

procedure TNewWindow.SetExpire(t: longInt);
    { Set the expiration date. }

    var dt: DateTimeRec;
        s: Str255;

    begin
        TLACSDocument(fDocument).fConfig.expireIn := t - GetNow;
        Secs2Date(t,dt);
        NumToString(dt.year,s);
        fMonth.SetCurrentItem(dt.month,true);
        fDay.SetCurrentItem(dt.day,true);
        fYear.SetText(Concat(', ',s),true);
    end;

{--------------------------------------------------------------------------------------------------}

{$S ARes}

procedure TStatusWindow.Bored;
    { Change status to "bored and idle..." }

    begin
        SetStatus(kStatBored);
    end;

{--------------------------------------------------------------------------------------------------}

{$S AFields}

procedure TStatusWindow.Fields(procedure DoToField(fieldName: Str255; fieldAddr: Ptr;
                                        fieldType: integer)); override;

    var i: integer;

    begin
        DoToField('TStatusWindow', nil, bClass);
        DoToField('fTotalMessages', @fTotalMessages, bObject);
        DoToField('fTotalPassed', @fTotalPassed, bObject);
        DoToField('fHotMessages', @fHotMessages, bObject);
        DoToField('fColdMessages', @fColdMessages, bObject);
        for i := 1 to kMaxNodes do
            DoToField(Concat('fGossipWith[',LongAsString(i),']'), @fGossipWith[i], bObject);
        DoToField('fStatus', @fStatus, bObject);
        DoToField('fLastStatusChange', @fLastStatusChange, bLongInt);
        inherited Fields(DoToField);
    end;

{--------------------------------------------------------------------------------------------------}

{$S AInit}

procedure TStatusWindow.FindSubviews;
    { Lookup all our subviews for later. }

    begin
        fTotalMessages := TNumberText(FindSubView('Tota'));
        fTotalPassed := TNumberText(FindSubView('Pass'));
        fHotMessages := TNumberText(FindSubView('HotR'));
        fColdMessages := TNumberText(FindSubView('Cold'));
        fGossipWith[1] := TStaticText(FindSubView('Gos1'));
        fGossipWith[2] := TStaticText(FindSubView('Gos2'));
        fGossipWith[3] := TStaticText(FindSubView('Gos3'));
        fGossipWith[4] := TStaticText(FindSubView('Gos4'));
        fGossipWith[5] := TStaticText(FindSubView('Gos5'));
        fGossipWith[6] := TStaticText(FindSubView('Gos6'));
        fGossipWith[7] := TStaticText(FindSubView('Gos7'));
        fGossipWith[8] := TStaticText(FindSubView('Gos8'));
        fGossipWith[9] := TStaticText(FindSubView('Gos9'));
        fGossipWith[10] := TStaticText(FindSubView('Gos0'));
        fStatus := TStaticText(FindSubView('Stat'));
    end;

{--------------------------------------------------------------------------------------------------}

{$S ARes}

procedure TStatusWindow.IncColdMessages(i: integer);
    { Increment the current cold messages count by i. }

    begin
        fColdMessages.SetValue(fColdMessages.GetValue+i,true);
    end;

{--------------------------------------------------------------------------------------------------}

{$S ARes}

procedure TStatusWindow.IncHotMessages(i: integer);
    { Increment the current hot messages count by i. }

    begin
        fHotMessages.SetValue(fHotMessages.GetValue+i,true);
    end;

{--------------------------------------------------------------------------------------------------}

{$S ARes}

procedure TStatusWindow.IncTotalPassed(i: integer);
    { Increment the total messages passed on count by i. }

    begin
        fTotalPassed.SetValue(fTotalPassed.GetValue+i,true);
    end;

{--------------------------------------------------------------------------------------------------}

{$S ARes}

procedure TStatusWindow.IncTotalMessages(i: integer);
    { Increment the total messages seen count by i. }

    begin
        fTotalMessages.SetValue(fTotalMessages.GetValue+i,true);
    end;

{--------------------------------------------------------------------------------------------------}

{$S ARes}

procedure TStatusWindow.SetStatus(statNum: integer);
    { Change the status display. }

    var s: Str255;

    begin
        fLastStatusChange := TickCount;
        GetIndString(s,kStatStrings,statNum);
        fStatus.SetText(s,true);
    end;

{--------------------------------------------------------------------------------------------------}

{$S ARes}

procedure TStatusWindow.UpdateGossipWith;
    { Update the display of who we're gossiping with. }

    var i: integer;
        n1: EntityName;
        nodeLooker: TNodeLookup;

    begin
        nodeLooker := TLACSDocument(fDocument).fNodeLooker;
        for i := 1 to nodeLooker.fNodeCount do
            begin
                n1 := nodeLooker.fNodes[i];
                with n1 do
                if zoneStr = '*' then fGossipWith[i].SetText(objStr,true)
                else fGossipWith[i].SetText(Concat(objStr,' @ ',zoneStr),true);
            end;
        for i := nodeLooker.fNodeCount + 1 to kMaxNodes do fGossipWith[i].SetText('',true);
    end;

{--------------------------------------------------------------------------------------------------}

{$S ARes}

function TMessageListView.DoMouseCommand(var theMouse: Point; var info: EventInfo;
                                                                    var hysteresis: Point): TCommand;
    { Handle mouse events. }

    var aRow, aCol: integer;
        r: TMessage;

    begin
        DoMouseCommand := gNoChanges;

        { Make sure this is a reasonable place to click. }
        if IdentifyPoint(theMouse, aRow, aCol) <> badChoice then
            begin
                if aRow <= fList.fSize then
                    begin
                        { Get the corresponding message. }
                        r := TMessage(fList.At(aRow));
                        { Mark it as read, in case it isn't already. }
                        r.MarkAsRead;
                        { Display the full text. }
                        fList.fDocument.fMessagesWindow.DisplayMessage(r);
                    end;
            end;
    end;

{--------------------------------------------------------------------------------------------------}

{$S AFields}

procedure TMessageListView.Fields(procedure DoToField(fieldName: Str255; fieldAddr: Ptr;
                                        fieldType: integer)); override;

    begin
        DoToField('TMessageListView', nil, bClass);
        DoToField('fList', @fList, bObject);
        inherited Fields(DoToField);
    end;

{--------------------------------------------------------------------------------------------------}

{$S ARes}

procedure TMessageListView.GetItemText(anItem: integer; var aString: Str255);
    { Retrieve the text for a particular item. }

    var r: TMessage;

    begin
        r := TMessage(fList.At(anItem));
        if r = nil then aString := 'No items available...'
        else r.AsString(aString);
    end;

{--------------------------------------------------------------------------------------------------}

{$S ARes}

procedure TPeriodic.Activate;
    { Start a periodic activity. }

    begin
        { To be filled in by a subclass. }
    end;

{--------------------------------------------------------------------------------------------------}

{$S ARes}

function TPeriodic.DoIdle(phase: IdlePhase): boolean;
    { Internal method -- idle the object. }

    var fi: FailInfo;

    procedure hdlFailure(error: OSErr; message: LongInt);
        { If we fail, reset to inactive. }

        begin
            fState := kPeriodicInactive;
            fIdleFreq := fInactiveIdle;
            exit(DoIdle);
        end;

    begin
        DoIdle := false;
        if phase = IdleContinue then
            begin
                CatchFailures(fi,hdlFailure);
                { If we've just timed out, then activate the object. }
                if fState = kPeriodicInactive then Activate
                else
                    begin
                        { If we're waiting, see if we're done yet. }
                        if fState = kPeriodicWaiting then Waiting;
                        { If we're done, do something with the results. }
                        if fState = kPeriodicActive then DoIt;
                    end;
                { Figure out the new idle frequency. }
                if fState = kPeriodicInactive then fIdleFreq := fInactiveIdle
                else fIdleFreq := fActiveIdle;
                Success(fi);
            end;
    end;

{--------------------------------------------------------------------------------------------------}

{$S ARes}

procedure TPeriodic.DoIt;
    { Handle the results of an async operation. }

    begin
        { To be filled in by a subclass. }
    end;

{--------------------------------------------------------------------------------------------------}

{$S AFields}

procedure TPeriodic.Fields(procedure DoToField(fieldName: Str255; fieldAddr: Ptr;
                                        fieldType: integer)); override;

    var s: Str255;

    begin
        DoToField('TPeriodic', nil, bClass);
        DoToField('fInactiveIdle', @fInactiveIdle, bLongInt);
        DoToField('fActiveIdle', @fActiveIdle, bLongInt);
        if fState = kPeriodicInactive then s := 'kPeriodicInactive'
        else if fState = kPeriodicWaiting then s := 'kPeriodicWaiting'
        else s := 'kPeriodicActive';
        DoToField('fState', @s, bString);
        inherited Fields(DoToField);
    end;

{--------------------------------------------------------------------------------------------------}

{$S ARes}

procedure TPeriodic.Free;
    { Free the object. }

    begin
        { First wait for any outstanding operation to complete. }
        while fState = kPeriodicWaiting do Waiting;
        { Deinstall ourselves from the co-handler chain. }
        gApplication.InstallCohandler(self,false);
        { Free ourselves. }
        inherited Free;
    end;

{--------------------------------------------------------------------------------------------------}

{$S ARes}

procedure TPeriodic.IPeriodic(initialIdle, inactiveIdle, activeIdle: longInt);
    { Initialize the object. }

    begin
        IEvtHandler(nil);
        fIdleFreq := initialIdle;
        fInactiveIdle := inactiveIdle;
        fActiveIdle := activeIdle;
        fState := kPeriodicInactive;
        { Install the object in the co-handler chain. }
        gApplication.InstallCohandler(self,true);
    end;

{--------------------------------------------------------------------------------------------------}

{$S ARes}

procedure TPeriodic.Kick;
    { Start things up even if it isn't normally time yet. }

    begin
        fIdleFreq := 0;
    end;

{--------------------------------------------------------------------------------------------------}

{$S ARes}

procedure TPeriodic.Waiting;
    { Test for async completion. }

    begin
        { To be filled in by a subclass. }
    end;

{--------------------------------------------------------------------------------------------------}

{$S ARes}

procedure TPssst.Activate;
    { Update the about box. }

    var ignore: OSErr;

    procedure psstIt(i: TIcon);
        { Update one icon. }

        begin
            { Only do it if we've got the right kind of view. }
            if Member(i,TIcon) then
                begin
                    { Toggle randomly between "pssst" and no "pssst". }
                    if (i.fRsrcID = kPsstHead) and (BAnd(Random,63) = 0) then
                        begin
                            i.SetIcon(GetIcon(kNoPsstHead),true);
                            i.fRsrcID := kNoPsstHead;
                        end
                    else if (i.fRsrcID = kNoPsstHead) and (BAnd(Random,63) = 0) then
                        begin
                            i.SetIcon(GetIcon(kPsstHead),true);
                            i.fRsrcID := kPsstHead;
                        end;
                end;
        end;

    begin
        { For each balloon, update the view. }
        if gAboutWindow.IsShown then gAboutWindow.EachSubView(psstIt);
    end;

{--------------------------------------------------------------------------------------------------}

{$S ARes}

procedure TMessagesExpirator.Activate;
    { Expire messages. }

    begin
        { First, kill of notify if present. }
        if not gInBackground then fDocument.fMessagesWindow.KillNotify;
        { Second, reset the expiration date in the New window. }
        fDocument.fNewWindow.ResetIfExpired;
        { Third, expire messages. }
        fDocument.ExpireMessages;
        { Forth, if enough time has gone by, reset status to "bored and idle..." }
        if (TickCount-fDocument.fStatusWindow.fLastStatusChange) > kStatusBoredRate then
            fDocument.fStatusWindow.Bored;
    end;

{--------------------------------------------------------------------------------------------------}

{$S AFields}

procedure TMessagesExpirator.Fields(procedure DoToField(fieldName: Str255; fieldAddr: Ptr;
                                        fieldType: integer)); override;

    begin
        DoToField('TMessagesExpirator', nil, bClass);
        DoToField('fDocument', @fDocument, bObject);
        inherited Fields(DoToField);
    end;

{--------------------------------------------------------------------------------------------------}

{$S ARes}

procedure TMessagesExpirator.IMessagesExpirator(aDoc: TLACSDocument;
                                                                            initialIdle, inactiveIdle, activeIdle: longInt);
    { Initialize message expirer. }

    begin
        IPeriodic(initialIdle,inactiveIdle,activeIdle);
        fDocument := aDoc;
    end;

{--------------------------------------------------------------------------------------------------}

{$S ARes}

procedure TDocumentSaver.Activate;
    { Get ready to save. }

    begin
        fState := kPeriodicWaiting;
    end;

{--------------------------------------------------------------------------------------------------}

{$S ARes}

procedure TDocumentSaver.DoIt;
    { Save the document. }

    begin
        fDocument.Save(cSave,false,false);
        fState := kPeriodicInactive;
    end;

{--------------------------------------------------------------------------------------------------}

{$S AFields}

procedure TDocumentSaver.Fields(procedure DoToField(fieldName: Str255; fieldAddr: Ptr;
                                        fieldType: integer)); override;

    begin
        DoToField('TDocumentSaver', nil, bClass);
        DoToField('fDocument', @fDocument, bObject);
        inherited Fields(DoToField);
    end;

{--------------------------------------------------------------------------------------------------}

{$S ARes}

procedure TDocumentSaver.IDocumentSaver(aDoc: TLACSDocument;
                                                                            initialIdle, inactiveIdle, activeIdle: longInt);
    { Initialize the document saver. }

    begin
        IPeriodic(initialIdle,inactiveIdle,activeIdle);
        fDocument := aDoc;
    end;

{--------------------------------------------------------------------------------------------------}

{$S ARes}

procedure TDocumentSaver.Waiting;
    { Wait until we're in the foreground. }

    begin
        if not gInBackground then fState := kPeriodicActive;
    end;

{--------------------------------------------------------------------------------------------------}

{$S ARes}

procedure TZoneLookup.Activate;
    { Start a zone list lookup. }

    var addrBlock: AddrBlock;
        ignore: integer;
        s: Str255;

    begin
        { Let the user know what we're doing. }
        fDocument.fStatusWindow.SetStatus(kStatZoneUpdate);
        { Clear out the zone list. }
        fZoneCount := 0;
        { Get our zone name. }
        with fXPPPBPtr^ do
            begin
                ioRefNum := xppRefNum;        { Driver refNum -41. }
                csCode := xCall;
                xppSubCode := zipGetMyZone;
                zipBuffPtr := @s;
                zipInfoField[1] := 0;        { ALWAYS 0. }
                zipInfoField[2] := 0;        { ALWAYS 0. }
            end;
        { Send the getMyZone request synchronously (and cross our electronic fingers it doesn't take long). }
        if PBControl(ParmBlkPtr(fXPPPBPtr), false) <> noErr then fState := kPeriodicInactive
        else
            begin
                { Update the display to reflect any changes. }
                if (s <> fOurZone) and (s <> '') then
                    begin
                        fOurZone := s;
                        fDocument.fNewWindow.GetSignature;
                    end;
                { Now make a getZoneList request. }
                with fXPPPBPtr^ do
                    begin
                        zipInfoField[1] := 0;            { ALWAYS 0 on first call; contains state info on subsequent calls. }
                        zipInfoField[2] := 0;            { ALWAYS 0 on first call; contains state info on subsequent calls. }
                        ioRefNum := XPPRefNum;    { Driver refNum -41. }
                        csCode := xCall;
                        xppSubCode := zipGetZoneList;
                        xppTimeOut := kXPPTimeOutVal;
                        xppRetry := kXPPRetryCount;
                        zipBuffPtr := Ptr(fZonesBuffer);    { This buffer will be filled with packed zone names. }
                        zipLastFlag := 0;
                    end;
                { Send off the request. }
                ignore := PBControl(ParmBlkPtr(fXPPPBPtr), true);
                fState := kPeriodicWaiting;
            end;
    end;

{--------------------------------------------------------------------------------------------------}

{$S ARes}

procedure TZoneLookup.DoIt;
    { Process returned zone list. }

    var  dCount: integer;
        dCurr: Ptr;
        ignore: OSErr;

    begin
        { Cycle through the returned list. }
        dCount := fXPPPBPtr^.zipNumZones;                                    { Find out how many returned. }
        dCurr := fZonesBuffer;                                                        { Put current pointer at start. }
        while (fZoneCount < kMaxZones) and (dCount > 0) do            { Get each zone. }
            begin
                fZoneCount := fZoneCount+1;
                fZones[fZoneCount][0] := chr(dCurr^);
                BlockMove(pointer(ord4(dCurr)+1),pointer(ord4(@fZones[fZoneCount])+1),dCurr^);
                dCurr := pointer(ord4(dCurr) + dCurr^+1);                { Bump up current pointer. }
                dCount := dCount-1;
            end;
        { If there are more to come, do another request. }
        if (fZoneCount < kMaxZones) and (fXPPPBPtr^.zipLastFlag = 0) then
            begin
                ignore := PBControl(ParmBlkPtr(fXPPPBPtr), true);
                fState := kPeriodicWaiting;
            end
        { Otherwise, we're all done. }
        else fState := kPeriodicInactive;
    end;

{--------------------------------------------------------------------------------------------------}

{$S ARes}

function TZoneLookup.GetRandomZone: Str32;
    { Pick a random zone from the list and return it. }

    begin
        { If there are no zones in the list, then return the local zone. }
        if (fZoneCount = 0) or ((abs(Random) mod fDocument.fConfig.inZoneSearch) = 0) then GetRandomZone := '*'
        { Otherwise, return a random zone from the zone list. }
        else GetRandomZone := fZones[abs(Random) mod fZoneCount + 1];
    end;

{--------------------------------------------------------------------------------------------------}

{$S AFields}

procedure TZoneLookup.Fields(procedure DoToField(fieldName: Str255; fieldAddr: Ptr;
                                        fieldType: integer)); override;

    var p: Ptr;

    begin
        DoToField('TZoneLookup', nil, bClass);
        DoToField('fDocument', @fDocument, bObject);
        DoToField('fZoneCount', @fZoneCount, bInteger);
        DoToField('fXPPPBPtr', @fXPPPBPtr, bPointer);
        DoToField('fZonesBuffer', @fZonesBuffer, bPointer);
        DoToField('fOurZone',@fOurZone,bString);
        p := @fZones;
        DoToField('fZones', @p, bPointer);
        inherited Fields(DoToField);
    end;

{--------------------------------------------------------------------------------------------------}

{$S ARes}

procedure TZoneLookup.Free;
    { Free the zone lookup object. }

    begin
        DisposPtr(Ptr(fXPPPBPtr));
        DisposPtr(fZonesBuffer);
        inherited Free;
    end;

{--------------------------------------------------------------------------------------------------}

{$S ARes}

procedure TZoneLookup.IZoneLookup(aDoc: TLACSDocument; initialIdle, inactiveIdle, activeIdle: longInt);
    { Initialize the zone lookup object. }

    begin
        IPeriodic(initialIdle,inactiveIdle,activeIdle);
        fDocument := aDoc;
        fOurZone := '';
        fZoneCount := 0;
        { Allocate memory blocks we'll need later. }
        fXPPPBPtr := xCallPtr(NewPtr(sizeof(xCallParam)));
        FailNil(fXPPPBPtr);
        fZonesBuffer := NewPtr(kZonesBufferSize);
        FailNil(fZonesBuffer);
    end;

{--------------------------------------------------------------------------------------------------}

{$S ARes}

procedure TZoneLookup.Waiting;
    { Wait for the zone lookup to complete. }

    begin
        if fXPPPBPtr^.ioResult = noErr then fState := kPeriodicActive
        else if fXPPPBPtr^.ioResult < noErr then fState := kPeriodicInactive;
    end;

{--------------------------------------------------------------------------------------------------}

{$S ARes}

procedure TNodeLookup.Activate;
    { Start a node lookup. }

    var addrBlock: AddrBlock;
        ignore: integer;
        theZone: Str32;

    begin
        { Let the user know what's going on. }
        fDocument.fStatusWindow.SetStatus(kStatNodeUpdate);
        { Pick a zone to look in. }
        theZone := fDocument.fZoneLooker.GetRandomZone;
        fZone := theZone;
        { Build a lookup request. }
        NBPSetEntity(fNameBuffer,'=',kLACS,theZone);
        with fpBlock^ do
            begin
                ioCompletion := nil;
                interval := kNBPTimeOutVal;
                count := kNBPRetryCount;
                entityPtr := fNameBuffer;
                retBuffPtr := fLookupBuf;
                retBuffSize := kLookupBufferSize;
                maxToGet := kMaxLookupNames;
                numGotten := 0;
            end;
        { Do the lookup. }
        ignore := PLookupName(fpBlock,true);
        fState := kPeriodicWaiting;
    end;

{--------------------------------------------------------------------------------------------------}

{$S ARes}

procedure TNodeLookup.DoIt;
    { Process the results of a node lookup. }

    var doNodeUpdate: boolean;
        doShortNodeUpdate: boolean;
        name: EntityName;
        addr: AddrBlock;
        i: integer;

    begin
        { Check if we got any results at all. }
        if fpBlock^.numGotten > 0 then
            begin
                { If so, get the name. }
                FailOSErr(NBPExtract(fLookupBuf,fpBlock^.numGotten,abs(Random) mod fpBlock^.numGotten + 1,
                                name,addr));
                { Get the zone from our own records. }
                name.zoneStr := fZone;
                doNodeUpdate := true;
                { Check if we've found ourselves. }
                if (name.objStr = GetString(kChooserName)^^) and (name.zoneStr = '*') then doNodeUpdate := false
                { Otherwise, check if we've found a node we already had in the list. }
                else
                    for i := 1 to fNodeCount do
                        if (name.objStr = fNodes[i].objStr) and (name.zoneStr = fNodes[i].zoneStr) then
                            begin
                                doNodeUpdate := false;
                                leave;
                            end;
                { If we've really got a new node to add in... }
                if doNodeUpdate then
                    begin
                        { Figure out where to add it (extend the list or replace an existing entry). }
                        if fNodeCount < kMaxNodes then
                            begin
                                fNodeCount := fNodeCount + 1;
                                i := fNodeCount;
                            end
                        else i := abs(Random) mod kMaxNodes + 1;
                        { Save the new node. }
                        fNodes[i] := name;
                        fAddrs[i] := addr;
                        { Update the display for the user. }
                        fDocument.fStatusWindow.UpdateGossipWith;
                    end;
            end;
        { Decide if we should be doing a short or long time-out. }
        doShortNodeUpdate := false;
        if fNodeCount = 0 then doShortNodeUpdate := true
        else
            begin
                doShortNodeUpdate := true;
                for i := 1 to fNodeCount do
                    if fNodes[i].zoneStr <> '*' then doShortNodeUpdate := false;
            end;
        { Set up the new time-out. }
        if doShortNodeUpdate then fInactiveIdle := fFastIdle
        else fInactiveIdle := fSlowIdle;
        fState := kPeriodicInactive;
    end;

{--------------------------------------------------------------------------------------------------}

{$S AFields}

procedure TNodeLookup.Fields(procedure DoToField(fieldName: Str255; fieldAddr: Ptr;
                                        fieldType: integer)); override;

    var p: Ptr;

    begin
        DoToField('TNodeLookup', nil, bClass);
        DoToField('fDocument', @fDocument, bObject);
        DoToField('fSlowIdle', @fSlowIdle, bLongInt);
        DoToField('fFastIdle', @fFastIdle, bLongInt);
        DoToField('fNodeCount', @fNodeCount, bInteger);
        DoToField('fNameBuffer', @fNameBuffer, bPointer);
        DoToField('fZone', @fZone, bString);
        DoToField('fpBlock', @fpBlock, bPointer);
        p := @fNodes;
        DoToField('fNodes', @p, bPointer);
        p := @fAddrs;
        DoToField('fAddrs', @p, bPointer);
        inherited Fields(DoToField);
    end;

{--------------------------------------------------------------------------------------------------}

{$S ARes}

procedure TNodeLookup.Free;
    { Free the node lookup object. }

    begin
        { Free our buffers and IO blocks. }
        DisposPtr(fNameBuffer);
        DisposPtr(Ptr(fpBlock));
        DisposPtr(fLookupBuf);
        { Free ourself. }
        inherited Free;
    end;

{--------------------------------------------------------------------------------------------------}

{$S ARes}

function TNodeLookup.GetRandomNode(var addr: AddrBlock): boolean;
    { Pick a random node from the list and return it. GetRandomNode itself returns true if we had a node to return. }

    var i: integer;

    begin
        GetRandomNode := false;
        { It only works if there are any nodes to pick from. }
        if fNodeCount > 0 then
            begin
                { Pick a node to return. }
                i := abs(Random) mod fNodeCount + 1;
                { Build a confirm query. }
                with fpBlock^ do
                    begin
                        ioCompletion := nil;
                        interval := kNBPTimeOutVal;
                        count := kNBPRetryCount;
                        with fNodes[i] do NBPSetEntity(fNameBuffer,objStr,typeStr,zoneStr);
                        entityPtr := fNameBuffer;
                        confirmAddr := fAddrs[i];
                        addr := confirmAddr;
                    end;
                { Confirm that the node's still there. }
                if PConfirmName(fpBlock,false) = noErr then GetRandomNode := true
                { Otherwise, remove it form the list. }
                else
                    begin
                        BlockMove(Ptr(ord4(@fNodes)+i*sizeof(EntityName)),
                                            Ptr(ord4(@fNodes)+(i-1)*sizeof(EntityName)),
                                            (fNodeCount-i)*sizeof(EntityName));
                        BlockMove(Ptr(ord4(@fAddrs)+i*sizeof(AddrBlock)),
                                            Ptr(ord4(@fAddrs)+(i-1)*sizeof(AddrBlock)),
                                            (fNodeCount-i)*sizeof(AddrBlock));
                        fNodeCount := fNodeCount-1;
                        fDocument.fStatusWindow.UpdateGossipWith;
                    end;
            end;
    end;

{--------------------------------------------------------------------------------------------------}

{$S ARes}

procedure TNodeLookup.INodeLookup(aDoc: TLACSDocument; initialIdle, fastIdle, slowIdle, activeIdle: longInt);
    { Initialize the node lookup object. }

    begin
        IPeriodic(initialIdle,slowIdle,activeIdle);
        fDocument := aDoc;
        fSlowIdle := slowIdle;
        fFastIdle := fastIdle;
        fNodeCount := 0;
        { Allocate buffers and IO blocks for later. }
        fNameBuffer := NewPtr(100);
        FailNil(fNameBuffer);
        fpBlock := MPPPBPtr(NewPtr(sizeof(MPPParamBlock)));
        FailNil(fpBlock);
        fLookupBuf := NewPtr(kLookupBufferSize);
        FailNil(fLookupBuf);
    end;

{--------------------------------------------------------------------------------------------------}

{$S ARes}

procedure TNodeLookup.Waiting;
    { Wait for a node lookup to complete. }

    begin
        if fpBlock^.ioResult = noErr then fState := kPeriodicActive
        else if fpBlock^.ioResult < noErr then fState := kPeriodicInactive;
    end;

{--------------------------------------------------------------------------------------------------}

{$S ARes}

procedure TGossip.Activate;
    { Start a new gossip session (outgoing only). }

    var addr: AddrBlock;
        r: TMessage;
        ignore: OSErr;

    begin
        { Only initiate a session if we're outgoing -- actually, Activate should never get called if we're not, but,
            hey, I'm paranoid, what can I tell ya? }
        fState := kPeriodicInactive;
        if fOutgoing then
            begin
                { Get a node to gossip with. }
                if fDocument.fNodeLooker.GetRandomNode(addr) then
                    begin
                        { Let the user know what's happening. }
                        fDocument.fStatusWindow.SetStatus(kStatGossiping);
                        { Get a message to spread. }
                        r := fDocument.GetHotMessage;
                        if r <> nil then
                            if not r.fForward then r := nil;
                        { Decide if we have anything to spread or not. }
                        if fDocument.fConfig.pull or (r <> nil) or (fDocument.fConfig.pullOnLess > fDocument.fMessages.fSize) then
                            begin
                                { Build an ADSP session open request. }
                                with fADSP^ do
                                    begin
                                        { Issue an active open command. }
                                        remoteAddress := addr;
                                        filterAddress := AddrBlock(0);
                                        ocMode := ocRequest;
                                        ocInterval := 0;
                                        ocMaximum := 0;
                                        csCode := dspOpen;
                                    end;
                                { Open an ADSP session. }
                                ignore := PBControl(ParmBlkPtr(fADSP),true);
                                fDidPull := false;
                                fState := kPeriodicWaiting;
                            end;
                    end;
            end;
    end;

{--------------------------------------------------------------------------------------------------}

{$S ARes}

procedure TGossip.DoIt;
    { Handle new input. }

    var r: TMessage;
        p: Ptr;
        noGood: boolean;

    begin
        noGood := false;
        { If this is a session open and we're the initiator... }
        if (fADSP^.csCode = dspOpen) and fOutgoing then
            begin
                { Get a message to send. }
                r := fDocument.GetHotMessage;
                if r <> nil then
                    if not r.fForward then r := nil;
                { Decide if we've something worth sending. }
                if fDocument.fConfig.pull or (r <> nil) or (fDocument.fConfig.pullOnLess > fDocument.fMessages.fSize) then
                    begin
                        { Generate the appropriate send request. }
                        with fADSP^ do
                            begin
                                p := fADSPData;
                                if fDocument.fConfig.pullOnLess > fDocument.fMessages.fSize then reqCount := BuildPullCold(p)
                                else if fDocument.fConfig.pull then
                                    begin
                                        reqCount := BuildPull(p);
                                        fDidPull := true;
                                    end
                                else reqCount := r.BuildMessageCommand(p);
                                dataPtr := fADSPData;
                                eom := 1;
                                flush := 1;
                                csCode := dspWrite;
                            end;
                        { Send it. }
                        if PBControl(ParmBlkPtr(fADSP),true) <> noErr then noGood := true;
                    end
                else noGood := true;
            end
        { If this is a completed read... }
        else if fADSP^.csCode = dspRead then
            begin
                { Handle the incoming command, and build a reply if approriate. }
                with fADSP^ do
                    begin
                        reqCount := fDocument.HandleIncomingCommand(fADSPData,fADSP^.actCount);
                        if (reqCount = 0) and fOutgoing and (not fDidPull) then
                            begin
                                reqCount := BuildPull(fADSPData);
                                fDidPull := true;
                            end;
                        dataPtr := fADSPData;
                        eom := 1;
                        flush := 1;
                        csCode := dspWrite;
                    end;
                { If there's a reply, send it. }
                if fADSP^.reqCount > 0 then
                    begin
                        if PBControl(ParmBlkPtr(fADSP),true) <> noErr then noGood := true;
                    end
                else noGood := true;
            end
        { Otherwise... }
        else
            begin
                { Start up a receive. }
                with fADSP^ do
                    begin
                        dataPtr := fADSPData;
                        reqCount := kADSPMaxCommand;
                        csCode := dspRead;
                    end;
                if PBControl(ParmBlkPtr(fADSP),true) <> noErr then noGood := true;
            end;
        { If we're all done, reset the connection. }
        if noGood then ResetConnection
        { Otherwise, wait for the results. }
        else fState := kPeriodicWaiting;
    end;

{--------------------------------------------------------------------------------------------------}

{$S AFields}

procedure TGossip.Fields(procedure DoToField(fieldName: Str255; fieldAddr: Ptr;
                                        fieldType: integer));

    begin
        DoToField('TGossip', nil, bClass);
        DoToField('fDocument', @fDocument, bObject);
        DoToField('fOutgoing', @fOutgoing, bBoolean);
        DoToField('fDidPull', @fDidPull, bBoolean);
        DoToField('fADSPSocket', @fADSPSocket, bInteger);
        DoToField('fADSP', @fADSP, bPointer);
        DoToField('fCcbPtr', @fCcbPtr, bPointer);
        DoToField('fSendQueue', @fSendQueue, bPointer);
        DoToField('fRecvQueue', @fRecvQueue, bPointer);
        DoToField('fAttnPtr', @fAttnPtr, bPointer);
        DoToField('fADSPData', @fADSPData, bPointer);
        DoToField('fNTE', @fNTE, bPointer);
        inherited Fields(DoToField);
    end;

{--------------------------------------------------------------------------------------------------}

{$S ARes}

procedure TGossip.Free;
    { Free the gossip object. }

    var pBlock: MPPParamBlock;
        io: DSPParamBlock;
        ignore: OSErr;

    begin
        { Remove the names table entry. }
        if not fOutgoing then
            begin
                pBlock.entityPtr := Ptr(ord4(@fNTE^.nteData)+1);
                ignore := PRemoveName(@pBlock,false);
            end;
        { Get rid of the ADSP connection. }
        io := fADSP^;
        io.abort := 1;
        io.csCode := dspRemove;
        ignore := PBControl(@io,false);
        { Dispose our buffers and IO blocks. }
        DisposPtr(fCcbPtr);
        DisposPtr(fSendQueue);
        DisposPtr(fRecvQueue);
        DisposPtr(fAttnPtr);
        DisposPtr(Ptr(fADSP));
        DisposPtr(fADSPData);
        fState := kPeriodicInactive;
        inherited Free;
    end;

{--------------------------------------------------------------------------------------------------}

{$S ARes}

procedure TGossip.IGossip(aDoc: TLACSDocument; outgoing: boolean; initialIdle, inactiveIdle, activeIdle: longInt);
    { Initialize the gossip object. }

    var pBlock: MPPParamBlock;
        s: Str255;

    begin
        IPeriodic(initialIdle,inactiveIdle,activeIdle);
        fDocument := aDoc;
        fOutgoing := outgoing;

        { Allocate buffers and IO blocks. }
        fADSP := DSPPBPtr(NewPtr(sizeof(DSPParamBlock)));
        FailNil(fADSP);
        fADSPData := NewPtr(kADSPMaxCommand);
        FailNil(fADSPData);

        { Fill in the ADSP IO block. }
        with fADSP^ do
            begin
                ioCRefNum := gADSP;
                ioCompletion := nil;
                ccbPtr := TPCCB(NewPtr(sizeof(TRCCB)));
                FailNil(ccbPtr);
                fCcbPtr := Ptr(ccbPtr);
                userRoutine := nil;
                sendQSize := kADSPSendBufSize;
                sendQueue := NewPtr(kADSPSendBufSize);
                FailNil(sendQueue);
                fSendQueue := sendQueue;
                recvQSize := kADSPRecvBufSize;
                recvQueue := NewPtr(kADSPRecvBufSize);
                FailNil(recvQueue);
                fRecvQueue := recvQueue;
                attnPtr := NewPtr(attnBufSize);
                FailNil(attnPtr);
                fAttnPtr := attnPtr;
                localSocket := 0;
                csCode := dspInit;
            end;
        FailOSErr(PBControl(ParmBlkPtr(fADSP),false));
        fADSPSocket := fADSP^.localSocket;

        { If we're incoming, do a passive open and register us on NBP. }
        if not fOutgoing then
            begin
                PassiveOpen;
                fNTE := Pointer(NewPtr(sizeof(NamesTableEntry)));
                FailNil(fNTE);
                s := GetString(kChooserName)^^;
                NBPSetNTE(Ptr(fNTE),s,kLACS,'*',fADSPSocket);
                with pBlock do
                    begin
                        interval := kNBPTimeOutVal;
                        count := kNBPRetryCount;
                        entityPtr := Ptr(fNTE);
                        verifyFlag := 1;
                    end;
                FailOSErr(PRegisterName(@pBlock,false));
            end;
    end;

{--------------------------------------------------------------------------------------------------}

{$S ARes}

procedure TGossip.PassiveOpen;
    { Do a passive connection open. }

    var ignore: OSErr;

    begin
        { Build an ADSP passive open request. }
        with fADSP^ do
            begin
                { Issue a passive open command. }
                ioCompletion := nil;
                filterAddress := AddrBlock(0);
                ocMode := ocPassive;
                ocInterval := 0;
                ocMaximum := 0;
                csCode := dspOpen;
            end;
        { Open it. }
        ignore := PBControl(ParmBlkPtr(fADSP),true);
        fState := kPeriodicWaiting;
    end;

{--------------------------------------------------------------------------------------------------}

{$S ARes}

procedure TGossip.ResetConnection;
    { Reset the connection. }

    var ignore: OSErr;

    begin
        { Build an ADSP close connection request. }
        with fADSP^ do
            begin
                abort := 0;
                csCode := dspClose;
            end;
        { Close the connection. }
        ignore := PBControl(ParmBlkPtr(fADSP),false);
        { Then reopen a listen if we're doing input, or reset to timing out if we're doing output. }
        if not fOutgoing then PassiveOpen
        else fState := kPeriodicInactive;
    end;

{--------------------------------------------------------------------------------------------------}

{$S ARes}

procedure TGossip.Waiting;
    { Wait for more input or a connection to open. }

    var ignore: OSErr;

    begin
        { We've got something if the operation has completed, and it isn't a zero-length read. }
        if (fADSP^.ioResult = noErr) and ((fADSP^.csCode <> dspRead) or (fADSP^.actCount <> 0)) then
            begin
                if not fOutgoing then fDocument.fStatusWindow.SetStatus(kStatIncomingConnect);
                fState := kPeriodicActive;
            end
        else if fADSP^.ioResult <= noErr then ResetConnection;
    end;